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A FORTRAN IV TWO-DIMENSIONAL DISCRETE ANGULAR 
SEGMENTATION TRANSPORT PROGRAM 
by Clayton E. Barber 
Lewis Research Center 

SUMMARY 

The development of the discrete angular segmentation method is given for solving the 
transport equation for a multigroup two-dimensional FORTRAN IV program. Finite - 
difference equations are derived in some detail and calculational procedures are dis- 
cussed. The application of scaling and overrelaxation as methods to accelerate the con- 
vergence of the neutron fluxes is described. The effect of these methods on convergence 
rates for selected problems is shown. The program is described, including the input 
instructions, along with some notes concerning program operation. A sample problem 
and a FORTRAN IV listing are also included. 


INTRODUCTION 

A transport program is required because of the inability of diffusion theory to give 
acceptable results for some problems. For example, the discrepancies between dif- 
fusion theory and experiment for some high leakage cores, for the streaming along void 
regions, and for thin highly absorptive regions makes this need apparent. The discrete 
angular segmentation method of transport theory has yielded smaller discrepancies than 
diffusion theory for problems of these types. 

The discrete angular segmentation or S n method was originally developed by 
Carlson at Los Alamos Scientific Laboratory (refs. 1 to 3). The S n method is basically 
a numerical, iterative difference method in which the continuous angular distribution of 
neutron velocities is represented by considering discrete angular directions. This 
method was originally developed for the calculation of fast -reactor assemblies that 
usually converged rapidly. It has since been applied to a wide variety of problems. Some 
of these problems such as those with large regions of long neutron lifetime, thermal re- 
actor systems, or complex two-dimensional problems sometimes converge very slowly. 



It is thus desirable to accelerate the flux convergence as much as possible. 

The TDSN program was developed in recognition of the need for a FORTRAN IV 
multigroup two-dimensional S n transport program that would converge these problems 
by the application of overrelaxation methods to the flux and source iterations. Various 
scaling procedures are discussed by Carlson (ref. 4), while other approaches to the 
problem of accelerating convergence are those of Putnam (ref. 5) and of Blue and Flatt 
(ref. 6). 

The TDSN program will solve either one -dimensional (slab, cylinder, or sphere) or 
two-dimensional (x, y or r, z) problems with either zero -return -current or reflective 
boundary conditions. The reflective condition for curved boundaries can be either mirror 
reflection from a plane surface or isotropic reflection. Certain types of geometric sym- 
metries are used to reduce the number of mesh intervals required in two-dimensional 
problems. Buckling losses for transverse directions can be included. The cross sec- 
tions can be either Pj or transport corrected Pq with full up- and down -scattering 
matrices. The array dimensions are completely flexible. Approximately 15 000 storages 
are required for the unsubscripted variables and the program, including the Lewis moni- 
tor system, so that about 17 500 storages are available for subscripted variables on a 
32 768 storage computer. 

Acceleration parameters may be used, and provisions are included to stop and re- 
start a problem after a specified running time or inner iteration count. On restart, the 
acceleration parameters, convergence criteria, and output options can be changed. 

Output options include activity tables, flux -weighted cross-section averaging, col- 
collapsed -group cross sections, disadvantage factors, and edits over specified groups 
arid mesh intervals. Input options include using a flat initial flux guess, reading in an 
initial flux guess, or using a binary card dump of a previous problem as a flux guess. 
Direction cosines and weights may be included in the input or may be calculated by the 
program by using a moment modified quadrature procedure. 

Another limitation on problems to be run by TDSN, besides size, is that the eigen- 
value must be the multiplication factor. Thus, no option for running a calculation with 
either an external source or a distributed internal source is available. 


SYMBOLS 

— 2 

Ajk area of mesh-cell surface at r. and z^ normal to ?, cm 

— - o 

Cik area of mesh -cell surface at r. and z^ normal to k, cm 

c number of neutrons emitted per collision, (i^S* + L s )/S t 

f scale factor 


2 


t 


G 


i,i,k 

V® 


k ett 

n 

p*u) 

P »m^) 

r 

r,z 

S(u,p,0) 


S g (p,G) 


u 


w 

6 

e 

x 


ik 

ml 


v 

I 


P 

2 a (u,?) 


S f (u, P ) 


number of neutron lethargy groups 
unit vectors for rectangular coordinates 

neutron current in q-direction; net number of neutrons in lethargy group g 
per unit area flowing in the q-direction at point specified by p, 
neutrons/ cm^ 

neutron multiplication factor 
order of S n quadrature 
Legendre polynomial 
spherical harmonic 

associated Legendre polynomial 
unit vector in radial direction 

coordinate variables to specify position p, p = rr + zk, cm 

directional source; number of neutrons per unit solid angle per unit volume 
introduced per unit lethargy into direction J2 at position p, 

o 

neutrons/cm /sr/unit lethargy (see eq. (2)) 
total directional source for lethargy group g (see eq. (10)), 

O 

neutrons/ cm / sr 
neutron lethargy 

volume of mesh cell surrounding point r^, z^, cm 
quadrature weights for angular segment m, £ 
deviation of two results 
angle between k and 0 

growth factor for production; ratio of total production resulting from outer 
iteration to similar production at beginning of iteration 

average number of neutrons that appear as result of a nuclear fission 

cosine of 6 

position vector, cm 

probability per unit distance of neutron travel of a neutron at lethargy u 
and position p being absorbed by a nucleus, cm~* 

probability per unit distance of neutron travel of a nuclear fission at lethargy 
u and position p, cm 
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V 


S S (u,p) 

s s (u'-u ,p,h' • h) 


sVp) 

S tr (u,p) 

^ g (p) 

<p 

x(u)du 


^(u, p, ft) 


S2 

°x’ °y’ 


ft* ^(u, p, ft) 


u> 


probability per unit distance of neutron travel of neutron at 

lethargy u and position p being scattered by a nucleus, cm - * 

kernal for neutron -nucleus scattering per unit distance of neutron 
travel from lethargy u' about lethargy u per unit lethargy 
through angle cos (O'. O) at position p, per cm per unit lethargy 

total collision probability per unit distance of neutron travel at 

+ a g 1 

lethargy u and position p, S = S + S , cm 

macroscopic transport cross section per unit distance of neutron 
travel at lethargy u and position p, cm 

nondirectional scalar neutron flux; number of neutrons in lethargy 

2 

group g per unit area at point specified by p, neutrons/ cm 

A A 

angle between r and projection of n in plane perpendicular to k 

fission spectrum; probability that a neutron born in fission of a 
nucleus will be in lethargy interval du about lethargy u, 

f x(u)du = 1 

directional flux; number of neutrons per unit lethargy per unit 
solid angle per unit area at point specified by position vector p 
and flowing in direction h, neutrons/ cmV sr/unit lethargy 

direction of neutron flow at position p 

direction cosine to radial direction r cos (p^j 

rectangular coordinate direction cosines (O represents same 

z 

cosine as £) 

directional derivative; net flow of neutrons in direction O per 
unit lethargy per unit solid angle per unit volume away from 
point specified by position vector p, neutrons/ cm V 
sr/unit lethargy 

overrelaxation factor 


Subscripts: 

b 

g 

i 

k 


boundary 
lethargy group 

numerical position of mesh cell in first direction, r or x 
numerical position of mesh cell in second direction, y or z 
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f 


l numerical position from negative r- or x -direction of angular quadrature 

segment on unit sphere surrounding point i, k 

A* 

m numerical position from pole or k-direction of angular quadrature segment 

on unit sphere surrounding point i,k 

q represents generalized coordinate such as x, y, z, or r 

Superscripts: 


a 

act 

f 

in 

I 

n — 2n 
P 

P 

r 

s 

t 

tr 

up 

C) 


absorption 

activity 

fission 

inelastic scattering 
order of spherical harmonic 
n — 2n scattering 

present outer iteration being performed 

present inner iteration being performed 

scattering removal 

scattering 

total 

transport 

up -scattering, scattering to a group of higher energy 

average; over a subscript, midpoint of interval with which subscript is con- 
cerned 


( 1 ) 


TRANSPORT EQUATION AND BOUNDARY CONDITIONS FOR r,z GEOMETRY 

The time -independent Boltzmann equation of transport theory may be written as 
5 • V*( u , p, fi) + 2*(u, p)¥(u, p, 5) = S(u, p, h) 


where 


5 



V 


s(u,p,o) = *^£- f f vsV,p)*(u’,p,6’)du’ d 2 fr 

k eff 477 • / S2 f *u T 

+ — f ( S s (u'-u,p, £2' • ft)* (u\ p , fi’)du' d 2 ft' (2) 
47T •'ft'-V 

*(u, JT, ft) denotes the number of neutrons per unit lethargy per unit solid angle per unit 
area at the point specified by the position vector ft and flowing in the direction ft; 

E^u, p ) is the total collision probability at lethargy u per unit length at point p; and 
S(u, p, ft) is the source per unit lethargy per unit solid angle per unit volume in direction 
ft at position p. The equation represents a neutron conservation law stating that the 
total derivative in the direction ft of the neutron flux at position p per unit volume per 
unit lethargy per unit solid angle equals the number of neutrons introduced in that direc- 
tion less the number which are removed by collisions. Positive solutions of the equation 
may be obtained for only one value of the multiplication factor k^ such that the con- 
servation law will hold. The equation is linear in the flux and of first order in the vari- 
ables p and ft. 

Making the multigroup approximation to the continuous lethargy dependence of equa- 
tion (1) replaces it by G equations of similar form; one for each of the lethargy 
intervals over which the lethargy dependent variables are replaced by suitable averages. 
Each equation now receives the subscript g to denote the lethargy group and the equa- 
tions to be solved become 


6 • v* g (p, ft) + £g(p)* g (p, n) = s g (p, ft) g = 1 , . . . , g 


and 


g’=l 


^ f g ,(p) 




,(p,ft ? ) d 2 n* 


G 

+ > 7 -f ■ &)+„,^’ SV ) c|2f5, 

g g 

g’=l 


(3) 


(4) 


where E g , g (p, ft’ • ft) is the kernel for scattering from the group g' to group g through 
the angle cos -1 (O’ • ft). 

For two-dimensional r, z cylindrical symmetry, * depends on two spatial 
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coordinates, r and z, and two directional coordinates, £ and <p, and is an even func- 
tion of both i and <p. In sketch (a), r is the perpendicular distance from the axis of 
symmetry, z is the distance parallel to the axis from the reference plane, £ is the 

A At 

cosine of 0, which is the angle between the unit vectors k and O, and <p is the angle 

A A 

in the plane perpendicular to the axis between the unit vector r and the projection of O. 
References 4 and 7 discuss this geometry as well as other geometries. 

The directional derivative S2 • V^(?T,n) in the transport equation (eq. (3)) will now 
be derived. Note that O • V* = d’i'/ds, where ds is a distance laid off along S2 and 
where 


d4> djt dr_ d¥ dg 9z_ 
ds Sr 9s 9 <p ds 9z 9s 


From sketch (a); dr = (sin 0 ds)cos <p or 


dr . . ,.2 

— = sin 0 cos <p = fl - £ cos cp 

ds 


Also, 


-r d(p » (sin 0 ds)sin <p 


or 


dg -sin 0 sin g 
ds r 



sin g 


and 


7 


V 


dz = cos 8 ds 


or 


— = cos 6 
ds 


4 


Also note that dr/ds corresponds to fi r , and dz/ds corresponds to O z . 
Making these substitutions yields 

d¥ ~2 9* Vl-^ 2 . 9* > 9* 

— = f 1 - £ cos <£ — - sin ip — + £ — 

ds 3r r dip 9z 

and equation (3) becomes 



cos ip 


8 _!_g 

0r 




1 - r 


9* 


3* 


sin ip 


— + 1 
d(p 9z 


£ + Z t * = S 
g g g 


( 5 ) 


with 


* g = * g (r,z, i,<p) 


The first three terms of equation (5) are not in the usual form for expressing the 
divergence in cylindrical coordinates. This may be remedied by noting that 


9 (sin (pY$ 


dip 


3 \£ 

(cos <p)\f r + sin cp — 

3 <p 


and 


3(r*) = * + r !* 

3r 3r 


Using these relations gives 


9'k . . 3* 

sin ip — = (cos cp) r — 
dip dr 


+ 9[(sin <?)*] 

dip 


- cos <p 


3(r*) 

3r 


and equation (5) becomes 
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f 


Vi - 1 2 


cos <p 


a(r V 1^1 - 1 2 3 f sin< p)^g] 

3r r dcp 


9 *g t 

+ | — » + 2„* = S„ 
9z S S 


( 6 ) 


which is a suitable conservative form of the transport equation in cy lindr ical coordinates. 

Two basic boundary conditions can be placed on equation (6): reflective and non- 
reflective. The axis of the cylinder necessarily has the reflective condition applied. At 
the outer radius r^ of the system, the nonreflective or zero -return -current boundary 
condition is 


*(r b , z, 4, cp) = 0 0 < cp < 

2 


where cp is the angle in the plane perpendicular to the cylindrical axis between the unit 
vector r and the projection of S2 . 

At the upper or lower boundary z*, 

*(r, %, t,<p) = 0 

with -1 — £ ^ 0 at the upper boundary and 0 < < 1 at the lower boundary, where 4 is 

the cosine of the angle between the unit vectors k and O. 

For planar reflection, the radial boundary condition is expressed as ^(r^, z, |, cp) = 
*(r b > z , and at the axial boundaries as ¥(r, z b , £, cp) = ¥(r, z^, -£, cp). The planar 

reflective boundary condition for a curved boundary lacks physical meaning because this 
condition leaves, for example, ¥(r b ,z, £,tt/2) = 0 for r,z geometry. Another reflec- 
tive boundary condition (ref. 5) is an isotropic return condition defined by 


*(r b , z > ^ <P) 



(cos <jP’)^(r b , z, £’, (p')d? dcp' 



cos cp ' d£ T dcp' 


it 

— < cp < it 
2 


Mirror and 180° rotational symmetry conditions may be applied to x,y configura- 
tions in addition to the boundary conditions expressed previously for r, z geometry. 
Mirror symmetry may also be applied to the z -direction of r, z configurations. Mirror 
symmetry results in conditions expressed in the same manner as the planar reflective 
boundary conditions for the appropriate values of x, y, or z and for the correct range 
of cp and £. 
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The 180° rotational symmetry condition may be applied if rotating that portion of a 
system below one of its diagonals through 180° about its midpoint results in the same 
configuration as that above the diagonal. This condition is defined by 


*(x b -x, 0 ,£,<?) = *(x, 0, n-<p) 


where the origin is at the lower left corner of the configuration and its right boundary is 
at x b . 


SOURCE FUNCTION 


The scattering source (the second term of eq. (4)) may be represented in terms of 
integrals involving two independent functions of the direction J2. Expansions in spheri- 
cal harmonics are employed to permit these integrals to be evaluated approximately. 
Only the zero and first harmonics of the expansion of P^ m (0) will be represented. 
p^(£) represents the Legendre polynomials, and the associated Legendre poly- 

nomials. 

The following expressions (from ref. 8) 


p (>0 (n) = p t u) 


J_ 4 ( { 2 - ,)* 

2 l C\ d( l 


ISO 


' VttVnof P «' (9COS(m ’’ ) 
p ”« )sin<n " rt 


£ > 1; 0 < m < f 


£ > 1; 0 < m < £ 


where 


m (1 . t2\m/2 d i+m 

p?(«) = V—r 1 V- U 2 - D* 


2 f f! 


dZ 


f+m 


can be used to obtain the spherical harmonics 

p o,o< ft > - p o‘«> = 1 
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P 1, 0 ( “> c P l^) = * 


where 


*m< 6 >= V 

p i,-i< n ) - V 


=n_ 


i-4 cos <p =n 


1 - 4 sin <p hJ 2 


ft = ^/l - 4 2 (cos <p)i + ^/l - 4 2 (sin </?)j + 4k 
The harmonics have the orthogonality property 


21 


4ir 


r 1 / p r,> )p ^m<^ = V, ( V 


m 


and the addition formula 


P f (o- • 6) = £ P tm <n')P |m (n> 

m= -f 

The elastic scattering cross section may be expanded as 


L 

X ' 


S g._g(P>fr • ft) = / (2£ + l)ZgLg<P)Pi(& ■ ft) 


Z—/ 

f=0 


where 


s|L g (P ) = ^ yi^ g (p,n’ • ft)P £ (ft’ • ft)d 2 n 

and where 2®, _(p, O' • S2) is the kernel for elastic scattering from group 
& ~ _1 A A : 
through the angle cos (S2 f • S2) and the flux may be expanded as 


to group g 
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where 


•* 


* g (p, «) = 


ZZ ( - ^glm^fm^ 


1=0 m= -{. 




and where L is equal to infinity. However, for this study, L will be either 0 or 1. 
With these expansions, the elastic scattering source is given by 

G 

Sg (p,«)=^T Q foji* • to)* g ,(p,to’)<ito' 

g'*l 


U Li 

■11 

g'=l £=0 


(2£ + l)SgZ g (P) 


X- 

1 

m=-f 


g'fm' 


(p)P fm (n) (7) 


where L * 0 for P Q scattering and L = 1 for Pj^ scattering. 

If cross sections for inelastic and n — 2n scattering are available, they may be in- 
cluded by adding them to S®? to obtain a total scattering matrix defined by 

o & 

z v-g <?) ■ + 2s g'>> 

The group scattering cross section S^(p ) becomes 

G 

S gP) - Z ^ V'> + + s T-> 7) 

g’=l 

and the group scattering removal 2^(p) is similar to 2®(p), where the sum does not 
include g' equal to g. 

For cylindrical geometry, is even in <p. The only that is 
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odd in (p, yielding = 0, is Pj _j(n). Using the definition of f gfm gives 

f g , o, o© = z: f*S «> p o, 


or, since 


p 0 ,o<"> = 1 

'*.o,«e r >-i/* g K«A» 

This expression is just the integral of the directional flux over all directions, or the 
scalar flux. Therefore, make the identification 

V' r > sf g,o,o<P> 

For fg j q the definition of f results in 


or 


Vi.o« r >-£/v r ’ fiM ' 


4tt 

where £ = for cylindrical geometry. Therefore, 


2 h 




g 


and similarly for f . . , the identification 


results. 

Making these substitutions into equation (7) results in the scattering source, for 
L = 0, 

G 


s!J(p 

g 


g'=i 


g <p)* g ,cn 


( 8 ) 
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and, for L = 1 


U I 

g’=l l 


(p) 




w (?) + VTT 

g 


£ (cos (p ) J (p ) 

1 ~t 


and equation (4) becomes 


( 9 ) 


"g 


s g (p,n)= , 
6ti g’=l 


vjr 

^ (?)#„, (p) + sj(p, fi) 


(10) 


Equati on (9) m ay be generalized for other geometries by recognizing that £ = O z 
and that |^1 - ^ cos <p = £2 . Then equation (9) becomes 


G _ 


5 g<^>=X 


g’=l 


q 


.si 


\ — ' 


(ID 


for each direction q of the coordinate system. 

The source Sg(p, £2) may also be written in a form that separates contributions to the 
source from within the group and from other groups. To do this, let 


\jr 

F(p) t,Z f gt (p)* g ,(75) 


g’=l 

G 




g>=i 

gVg 




g’=l q 


( 12 ) 
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Then 


* 


Sg(p, o) = ^ F(P ) + T* cr) + Tg(p, R) + Sglg(P )* g (P) + 3S gIg(P ) V “ q Ja (P) (13) 

eff » ^ & 

q 

In many problems, anisotropic scattering is adequately taken into account by either 
the diagonal or the full transport approximation. For either of these approximations, 
anisotropic scattering is accounted for by an appropriate modification of the cross sec- 
tions, and on the use of these modified values, the scattering is treated as if it were 
isotropic: 


S g (p) = 



F(p ) + T* (p ) + 2gl g (p>g(p) 


(14) 


The transport approximation may be regarded as replacing an anisotropic scattering 
distribution with an isotropic component and a 6 -function forward scattering component. 
In the diagonal transport approximation (ref. 9), 2* is replaced by (2* - 2® 1 ) , and 
s gl g is replaced by ^gl g - where 



and 2* r is defined to be 2* - 2®*. 

g g g , 

A second method (ref. 2) of developing the transport approximation is to use 2„ as 

t gf & 

defined by a cross-section program to replace 2 . Then 2 is replaced by 

s l r - ~ SL where & b 

g g g’ 




+ 2 


in 


g-g' 


+ 2 


n— 2n\ 
g-g’ ) 


where 2?; is the cross section for neutron absorption including absorptions that result 

& st 

in fission. Under these circumstances, 2 may become negative. 

6 & 
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For an adjoint problem (refs. 7 and 10), the source is developed differently result- 
ing in 



?i) » rSg F*(p ) + Tg* Ip) + t’V, Si) + S^_ g 


<P)*g<P) + 32 jL g 




q 


( 15 ) 


where 







G 

T ‘V,S)=3^E=i g ,(p)^ V *(p) 

g-1 q 

g’/g 


( 16 ) 


SPATIAL MESH AND DIRECTIONAL SEGMENTATION 

The transport equation, as given for cylindrical symmetry by equation (6), can be 
solved by performing integrations over the direction variable fl such as those involved 
in the source function (eq. (4)). In obtaining numerical solutions, these integrations may 
be performed by means of mechanical quadrature in which the continuous variable O is 
represented by a set of discrete directions. The conversion of the transport equation into 
difference form also requires that the space coordinates represented by the continuous 
variable p be divided into a set of intervals. 

For the space dimensions, the division is arbitrary, and for the r, z cylindrical 
geometry, a set of r . is used to divide r into I intervals and a set of to divide z 
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* 


into K intervals. An i,k mesh results over the volume of the cylinder. In general, 
the mesh intervals are selected so that the surfaces of the resulting mesh cells coincide 
as much as possible with the natural bounding surfaces of the configuration being repre- 
sented. All the mesh cells are considered to be uniform in material and free of any 
internal boundaries. The radial and axial bounding areas of the mesh cells are given by 
Ajk = 2wrj Az^ and = v ^ r f + j " ^ and the volume of the mesh cell by 

V ik = *( r i+1 " r i) Az k- 

For the direction variables | and <p, a two-dimensional partition of the surface of 
a unit sphere centered at each mesh cell is required. Since i// and S are both even 
functions of q>, it is only necessary to consider the range of cp from zero to n. The 
directional variable £ is also even and, if no z variation exists, £ can be considered 
only for the range from zero to 1 and only the first quadrant of the unit sphere needs to 
be used. Even with z variation, the section of the unit sphere with £ between -1 and 
zero will have the same form of mechanical quadrature as the first quadrant, so that only 
the first quadrant needs to be considered in devising the quadrature scheme. In the past, 
a system of Gaussian quadrature (refs. 4 and 5) or a moment modified quadrature system 
(ref. 3) has been used. More recently projection -invariant quadrature sets have been 
proposed (refs. 4 and 7). 

Whatever quadrature system is to be used, certain relations should be required. 

The most important of these are 


z 

m, i 


w m < =1 


(17a) 


z 

m, 1 


w . = 0 
ml mf 


(17b) 


z 

m, £ 


ml mf 


1 

3 


(17c) 


In some quadrature sets (i. e. , the Double -P method and the projection -invariant Set B, 
ref. 4), the first moment relation 


m, £ 


(lid) 
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also holds. Except for equation (17b), these are all forms of a general condition 



1 

q + 1 


where q is the order of the moment. 

In the moment modified sets, the first quadrant of the unit sphere (and others if re - 
quired) is divided into n/2 bands of latitude by arcs of latitude of constant cosine |. 
These arcs are defined by dividing the continuous variable 4 into a set of 4 m * These 
bands are determined so that the areas of the bands, as 4 decreases, are 
na, (n - 2)a, . . . , 4a, 2a. The sum of these areas must be jr, the area of the first 
quadrant, or 



2ma = it 


where 


n/2 

^ ^ 2ma = 
m=l 


n 

2 


^n + 2 n 


a 


Thus, a = 47r/n(n + 2). Each band is now divided by arcs of longitude (<p constant) into 
sections of area a with the bands partitioned into L = n, n-2, . . ., 4, 2 sections. 
Here, the continuous variable <p is divided into a set of boundaries <P m £ so that 



as shown in sketch (b) for n = 6. 

With each area is associated an average value 
T of 4 and cp m e of <p. The average direction 


ml 


(!m> V m f) is chosen so that condition (17c) holds 
(ref. 3). In the quadrature system being con- 
sidered, this direction is obtained by defining 
to be the simple average 
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^m l + ^m, 1-1 


and with equal weights w mf (representing the areas), while | can be defined by 

1 . Vn 2 + 2n 


2 + ^m-1^ fY 


n 




+ 2n - 2 


m = 1, 2 , • • g 


and 


*m = < 


n-m+1 m g + ‘ ’ n 


where 


_ . 4m (m + 1) 
?m “ n(n + 2) 


m = 0, . . 


n 

2 


and 


^n-m 


m = -+ 1, . . . , n 
2 


Projection -invariant quadratures attempt to perform the quadrature subject to sym- 
metry requirements on the discrete directions dividing the surface of the unit sphere. 

The symmetry requirements are rotational invariance about the midpoint of an octant of the 
the unit sphere and reflection invariance about the spherical arcs connecting the midpoint 

of the octant and its vertices. With these re- 
quirements satisfied, the results of integrations 

A 

over no longer depend on the orientation of 
the unit sphere with respect to the space axes as 
they do for the moment modified quadrature. 

If the areas to be associated with the discrete 
directions to obtain the weighting factors w m ^ 
are laid out on the unit sphere and are made sub- 
ject to the invariance requirements, a diagram 
for an octant such as sketch (c) for n = 6 re- 
sults. 
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types of quadrature sets for a number of 


This figure is representative of the Set A 
quadrature of reference 4. The Set B quad- 
rature of reference 4 is obtained from the 
Set A quadrature for n + 2 by removing the 
corner directions. After n = 4, the total 
number of directions for Set B will be more 
than that for the corresponding Set A quad- 
rature. Sketch (d) represents an octant for 
n = 6 of Set B quadrature. (For a further 
discussion of projection -invarant methods 
see refs. 4 and 7.) Appendix B lists these 
s n orders. 


TRANSPORT DIFFERENCE EQUATION FOR r,z GEOMETRY 


Equation (6) can be put into difference form, as is done in reference 7, or another 
neutron conservation equation for the mesh cell i,k and quadrature segment m, £ can 
be developed (refs. 4 and 10). The first term of equation (6) represents the loss of neu- 
trons per unit volume in the r -direction from a differential spatial -directional element. 
The second term represents a similar loss in the (p -direction and the third represents a 
loss in the z -direction. Thus, the first term, following the procedure of references 4 
and 10, may be written in difference form as 


w mA 


( A i+l,k^n,i+l,k,m, < ' A ik^g,l,k, m, l) 


ml 


V ik 


which represents the net flow per unit volume out of the mesh cell i, k through the radial 

surfaces. In this term, w m ^ is the solid angle of the quadrature segment about the 

discrete direction m, £, 12 is the direction cosine of the angle between direction 

mi 

m, l and the radial direction yielding the component of the directional flux normal to the 

radial surfaces, A^ +1 k and A ik are the surface areas at (r i+ p z k ) and (r^ z" k ), and 

\{/„ i , i P m 7 311(1 . T” ’ — ~ represent the average directional flux over these sur- 

g, 1 +A,K, m ,f 6, A, K, m, JL 

faces. 

The third term is similar for the z -direction and becomes 


w m A 


( C l, k+l’Pg. i,k+l.m, t ' C lk'Pg, i.k, m, i) 


mf 


lk 
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representing the net flow per unit volume out of the mesh cell through the axial surfaces. 

The second term of equation (6) represents the angular redistribution of neutrons 
since it corresponds to the loss per unit volume in the <p -direction from the quadrature 
segment but not a loss from the mesh cell. In difference form this term may be written 
as 




mr g, i, k, m, i 


All a JL 


'ik 


where ij/ j r; — , and xj/ 7 r — . - represent average fluxes for the quadrature seg- 
ment boundaries of direction m, £. The quantities a m£ and « m are to be deter- 
mined so that the net angular redistribution in the cp -direction for any m will be zero. 

Making these substitutions into equation (6) and multiplying through by V ik result in 
the transport difference equation: 


w m f ^ r m £ ^ A i +! , k^g, i+1, k, m, i ' A ik^g, i, k, m, I* 


+ ^mi^g, iJL, m , i ~ a m, 1 -l^g, i,Ti, m, £ -1^ + w m£ 0 z mJ ^ C i, k+l^g, i, k+1, m, 1 
C ik^g,T, k, m, + w m£ S g, i, k V ik^g, i, k, m, T “ w m£ S g, i^ k, in, ik 


The coefficients must now be evaluated. Because of the cylindrical symmetry, 

the range of cp to be considered is from zero to n and there cannot be angular redistri- 
bution to values of cp outside this range. Therefore, the first and last values of a mJ ^ 
must be zero, imposing the conditions 


a- ft = a T = 0 
m, 0 m, Li 

Another condition can be determined by examining a configuration that results in con- 
stant directional flux. For such a configuration, the net flow will be zero, or from equa- 
tion (18), 


Wmt0r m« (A i +1 ’ k ' Afk> + +W mA m , (C i,k + l ' C ik> “ 0 


m£ 


For cylindrical geometry k+1 = and the third term is zero. This agrees with 
equation (6) since it indicates no angular redistribution in the £ -direction. 


The conditions on a mJ j thus reduce to 


21 



( 19 ) 


“m, 0 = “m, L = 0 


“ml - “m, 1-1 = - w mi n r m< < A i+l,k ’ A ik> 


Another expression for a m * can be found by noting that with 


a n = 0 
m, u 


and 


OL 


m,l= - w m,i n r m> / A i + l,k " V 


5 = -r V m +W m ,fi l(A u1 v - A.J 


‘m,2“ -^m,2“r m>2 TW m,l“r m>1 j^i+l,k ' ~ik' 

Substituting a m 2 and a m j into (19) gives 

“tv. •* = ■ ( w m oO_ +w m ,B r + .0 ) (A. , ,, - A.,) 

m,3 V m ’3r m>3 m, 2 r m , 2 m ’ 1 r m, 1/ 1+1 ’ k * 


or, in general, 


“ml = - l w m! n r 


mf 


+ w , ,S) 
m,£-l r 


m, £-1 


+ w m,l !i r 


m, 1 


(A 


1+1, k 


" A ik^ 


( 20 ) 


The equations represented by (18) (one equation for each mesh cell i, k and discrete 

direction m, £ and group g) do not couple different values of O , while the energy 

z m£ 

groups are coupled only through the source term. This system of equations can be 
solved by putting equation (18) into the form of a recursion relation, and the fluxes are 
calculated in turn. A complete set of fluxes can be obtained by starting the procedure at 
each geometric boundary and applying the recursion relation until the opposite boundary 
is reached. In carrying out this procedure, only those fluxes with directional components 
in the direction in which the recursion relation is being applied are obtained. The pro- 
cedure must be initialized with respect to direction in addition to the initialization at the 
boundaries. For this, the direction </? m Q =* n is used for which “ m q = 0 311(1 results 
in the procedure being started at the outer radial boundary. 

This procedure can be applied by putting the recursion relation into a form in which 
one unknown value of the flux can be determined from a set of previously calculated 
values. Thus, the number of unknowns in equation (18) must be reduced by three. One 
of two different methods is usually used. One method is known as the ’’step model" 
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4 


(or step-function method) and the other as the "diamond model" (or line-segment method). 
In the step model, the average flux ^ jjf-j for the mesh cell and quadrature segment 
is assumed to apply also at the mesh and quadrature boundaries yet to be reached in the re- 
cursion sweep. Thus, for a sweep from i to i + 1 and k to k + 1 the condition becomes 

^g,T, k, in, £ = ^g, 1+1, k, m, I = ^g,I, k+1, m, £ = ^g,T, k, in, £ 

For the diamond model, the average flux is assumed to be the average of the opposite 
boundary values or 


^ g , i, k, m, i 2 ^ S > i+1 > k, m, £ + ^g, i, k, m, l) 
= 2 k+1, m, £ + ^g,T, k, in, 7^ 


2 ^g,i,k,m,£ + ^g,i,k,m, £-1^ 

The diamond model is used in TDSN since it generally leads to accurate results. 

Using the diamond model for a recursion sweep from i to i + 1 and from k to 
k + 1 equation (18) becomes 


w mA 


ml L 


A i+1, k^g, i, k, m, £ " ^g, i, k, m, £^ 

" A ik^g,i,k,m, £ + a mf^ 2 ^g, i,k,m,I ‘ ^g,i,k,m, £-1^ " “m, £-l^g,!, k, m, £-lj 

C i, k+l^g, i, k, m, £ " ^g,I, k, m, 7* ' C ik^g,T, k, m, F 


+ w m£ n z 


in£ 


+ W m£ S g, i, k V ik^g, i, k, m, 1 w m£ S g, i, k, m, j^ik 


or 


2Wmffir mf Ai+1, k ^ g ’ *» k > m > 1 " Wm *° r m / Ai+ 1> k + A ik^g, i, k, m, I 
+ 2a m!^g, i, k, m, £ " ( a m£ + a m, £-l^g, i, k, m, £-1 

+ k+1 + C ik^g, i, k, m, I " w m£ n z m£ ( C i, k+1 + C ik^g, i, k, in, £ 


+ w m£ S g, i, k V ik^g, i, k, m, £ = w m£ S g, i, k, m, £ V ik 
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since C i, k+1 = C ik* 

A symmetrical relation for the first four terms similar to that of the fifth and sixth 
terms can be obtained when equation (19) is used in the form 

w rojf^ r mjj A i+l , k = “m, (-1 '“mi + "mt^/ik 


to substitute for w mJ ^ r A. + j ^ in the first term. Further symmetry can be obtained 
by noting that 


A i+i, k + A a - 2, < r i + i + r i> 4z k 

c i,k+i + c ik = 2,r ( r i+i + r i> ar i 


A i+l,k - Aik' 21 ar i Az k 
for cylindrical geometry. Thus, if the definition 

“mf + “m, £-1 = w m£ y m£^ A i+l,k " A ik^ ^ 

is used, the first six terms will have the same form. 

To determine r mJ j, subtract 2o! m ^ from both sides of equation (22) and use (19) 
to obtain 

“mf ' “m, £-1 _ " w m£^r mf ^ A i+l,k ” A ik^ ~ w m£ y m£^ A i+l,k " A ik^ ” 2 “m, £-1 
or 

w mfW A i + l,k - A lk> = 2 “m, <-l - w m« n r m / A i + l,k ‘ A ik> 

For £ = 1, 

“m,l-l = 0 

and 
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For 1 = 2 and using (20) to substitute for a m ^ j 

*“• 2Vm ' 2 = ' W ”> i, 2 * * * V 2 ' V A m> 1 ' W », l°r m> , 

and since y - = - fi 

m ’ 1 r m, 1 

w m,2’ , m,2 - w m,l y m,l = " < w m,2 n r m , +w m,l n r > 

m, z m, 1 


Continuing for 1 > 2, the relation 


V 1 = ‘ °r 


m, 1 


w. 


m, 


! y m, 1 " w m, £-l r m, 1-1 " + w m, f-i n r m ^ 1 > 1 


can be obtained. 

Solving for ^ k m T gives the difference equation as 


(23) 


[ nr mf (Ai+1 > k + **^ 8 . *. k, m, i + y mf (A i+l,k “ A ik^g, i,k, m, i -1 + n z m| (C i,k+l + C ftW'g, i, k, m, I + S g, i,k, m, 7 V ik] ^ 4 ) 

[ 1 ! r m j ,A i+I. k + A 1k ) + y mi tA l+l, k ' A ik J + n z m| (C i, k+1 + C ik ) + S g, i, k V ik] 


*g, i,k,m, t 


Equation (24) is the recursion relation for a sweep from i to i + 1 and from k to 
k + 1. Similar results for the other three possible sweep directions are obtained if 
*^g, i, k, m, f or *^g,T, k, m, T are replaced in equation (18) with or 

^g,T, k+1 m r which th en appear in an equation similar to (24). If the absolute values 
of the direction cosines are used, the same recursion relation may be used for all four 
possible sweep directions. Similar recursion relations may also be obtained for other 
geometries (see refs. 4 and 7). 

Another equation is required to obtain the initialization at the quadrature boundaries. 
This equation is obtained from an £ = 0 sweep for which y n = 0 and 




Vo-f 7 


S2 . Equation (24) is used to obtain an average flux over mesh cell 
z m,0 


i, k for the discrete direction m, 1. Values to be used in the same manner for successive 

mesh cells and directions are then computed by using equation (21) with 

^g, i, k, in f ~ T k in 1 for the quadrature initialization sweep. 

The diamond model used to obtain equation (24) can result in negative values being 

computed for use in the next mesh cell or direction segment, and this possibility must be 
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accounted for in the difference equation solution procedure (see page 27 and ref. 10). 

The scalar flux $ gik can be obtained by integrating £ over the direc " 

tions m and £ or 



^^ w m£^g,i,k,m, £ 
m, £ 


(25a) 


while the currents are 


gik 


■E 

m, £ 


W *0 

m£ r 


m£ 




m, £ 


and 


J gik 


•Z- 

m, £ 


*mA 


4>, 


mf 


g,i,k,m,£ 


(25b) 


(25c) 


DIFFERENCE EQUATION SOLUTION PROCEDURE 

The difference equations are solved by carrying out iterations on the flux until con- 
vergence has been obtained. The iterations are performed by assuming a source for a 
sweep through the recursion relations involved in solving the equations. If the 
source is unchanged by the sweep, it is considered to be converged. By unchanged, one 
means that the new source and the old source are within a specified small number of 
being identical. The actual values to be compared can be the integrated source over all 
the mesh intervals, the integrated source over a given set of mesh intervals, or the new 
and old source can be compared at each mesh interval. 

In the solution, the iterations performed are of two types. These are variously 
known as outer, major, or power iterations and inner, minor, or group iterations. The 
source is treated as inhomogeneous, and a portion of it is fixed for each power iteration. 
The fixed portion of the source is taken to be the fission source. The fixed source is 
normalized to a constant "power level" at the beginning of each power iteration. 

The up- and down -scattering into a given group g may also be considered part of 
the fixed source for this group. Then, for the group g, the fixed source becomes, from 
equation (13), 
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F + T* + T 1 
g g 


with similar results from equation (14) for transport approximation problems and 
from equation (15) for adjoint problems. 

To this group fixed source is added the portion of the source for which a new value is 
obtained for each group iteration. This source results from scattering within the group 
and becomes 


2 st + 32 s1 V' fi j 

g~g g g~g / / q J q g 

q 

from equation (13), with similar results from equations (14) and (15). 

The total source for the group iteration is then used for the sweep through the re- 
cursion relations of the S n method to obtain an improved estimate of the scalar flux and, 
in turn, of the within -group-scattering portion of the source. 

During the sweep through the recursion relations, negative values of the angular 
flux at mesh-cell and quadrature boundaries may be obtained because of the lack of a 
significant source, or because of a rapidly varying flux, or because of the lack of con- 
vergence of the source. Usually, these conditions may be remedied by rerunning the 
problem by the use of a finer spatial and, perhaps, angular mesh. However, when these 
negative values occur during the course of a computation, they can be handled in a num- 
ber of ways. Two possibilities are allowing the negative values to remain in hopes that 
they will cease to occur as the source converges and recalculating the angular flux by the 
step model in which the possibility of a negative flux does not occur (unless the total 
group source is negative due to a large negative transport corrected 2 S ^ or scat- 
tering term). The TDSN program replaces a negative angular flux with zero. If the 
negative values continue to be obtained, a pseudosource and an erroneous gain of neutrons 
to the system result. In obtaining the new flux estimates, a second or ’'reflection” 
sweep through the recursion relations may be required for reflective outer boundary 
problems to correct for nonzero boundary currents. The combination of the two sweeps 
is then known as the group iteration. 

In addition to an estimate of the source, the boundary angular fluxes are required at 
boundaries where recursion sweeps begin before the sweep can be started. Zero inward 
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current conditions require only that the angular flux be set to zero for the inward directed 
angles. Reflective boundary conditions, however, imply an inward source of neutrons at 
the boundary that must be obtained from an estimate of the inward angular fluxes. The 
estimate of these angular fluxes must also be improved, along with that of the scalar 
flux, as the group iterations are continued. 

If, after the sweep through the recursion relations has been completed, the neutron 
flow across the reflective boundary is not sufficiently close to zero, the reflective sweep 
may be performed as a correction. For this sweep, the last estimate of the boundary 
angul a r fluxes is used without any other source terms to compute a correction flux. The 
fluxes and flows from this sweep are then combined with those of the regular sweep so 
that the flow across the reflective boundary will be zero. 

The group iterations can then be continued until the within -group-scattering portion 
of the source ceases to change significantly, that is, until it is converged. The number 
of group iterations required for convergence may be decreased by the application of dif- 
ferent acceleration techniques discussed in the next section. 

After the final estimate of the scalar flux has been obtained for a group iteration, 
certain convergence tests are applied. These include tests on the change in the within - 
group -scattering source and the change in the collision removal that resulted from the 
iteration. Other tests may be on point or region changes in the source or loss. These 
tests are described in more detail in the next section. Since the solution should always 
satisfy neutron conservation from the nature of the transport difference equations, neu- 
tron balance cannot be used as a convergence test. 

When the tests are satisfied for a given group, the same procedure is followed for 
the remaining groups. The scattering source into these groups is always based on the 
latest estimate of the fluxes for the other groups, but the fission source is updated only 
at the end of the power iteration. Acceleration techniques may also be applied to the 
power iterations and are discussed in the next section. 

After the group iterations have been performed in the last group and any power itera- 
tion acceleration has been applied, the fission source is renormalized by first computing 
the production rate 



as in equation (12). Then the growth factor for production is obtained by the ratio 
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x p = ii 



i,k 


The estimate of the multiplication factor k resulting from the P** 1 iteration is then 
P P P-1 ei1 

given by = X k p ^ f . Using this new value of k eff yields a normalized total fission 
source equal to the fixed power level. 

For homogeneous problems, a nonvanishing solution only exists for certain unique 
values of k eff , and for only one of these values, corresponding to the fundamental mode, 
will the fluxes be everywhere positive. The latest estimate of k p ^ f is used to obtain the 
fixed source estimate of the following power iteration. The power iterations are repeated 
until A* 3 converges to 1 (indicating no change in the fission source for the iteration). 

Several tests are applied to determine the convergence of A . Among these can be 
a test on the closeness of A^* to 1, a test on the rate of change of A, and a test on the 
closeness of the group sum of the scattering source to the group sum of the scattering 
loss if the source does not contain extra neutrons from n — 2n scattering reactions. A 
test on the change in the up-scattering source resulting from the power iteration may also 
be applied. 

ACCELERATION AND TESTS OF CONVERGENCE 

In this section, the application of scaling and overrelaxation techniques to accelerate 
the convergence of the inner and outer iterations is discussed along with the convergence 
tests applied by the TDSN program. 

In the past, the only form of acceleration used has been the scaling factor applied to 
retain conservation of neutrons. Carlson discusses this use of scaling in reference 4 
and in the remarks following reference 2. The scaling factor f is an integral quantity 
being determined from the summation of the changes that result in the within-group- 
scattering source because of a group iteration and is written as 
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where is the volume of the mesh cell i, k. The flux estimate as well as 

the currents and angular boundary fluxes, resulting from a group iteration, are ac- 
celerated when multiplied by this scaling factor since it further changes the estimate in 
the same direction as the recursion sweep did on an integral basis. The effectiveness of 
this scaling factor may be negligible after a number of inner iterations. As convergence 
proceeds, the scaling factor quickly approaches 1 because increases in the within-group- 
scattering source in one region can be offset by decreases in another region with the 
overall flux level remaining almost constant. Thus no acceleration results. 

Further acceleration may be achieved through point -wise techniques that will sig- 
nificantly speed up the convergence process. The method used is "overrelaxation" 

(ref. 11) for iterations in which a specified degree of convergence has been attained. 
Overrelaxation uses the fluxes before and after an iteration. The accelerated flux esti- 
mate is then used in determining the integrated scaling factor. After partial flux con- 
vergence has been attained a more optimum acceleration parameter may be calculated 
by the method of Wachspress described in reference 12. 

When point -wise extrapolations of the fluxes are used, other point -wise quantities 
such as the boundary angular fluxes and currents will need to be corrected. The manner 
by which the correction factor for the overrelaxation is obtained is illustrated as follows. 
The extrapolated flux for mesh interval i, k is given by 


gik 


- - (<■> - DCl 1 


gik 


(27) 


where p is the present inner iteration. After the extrapolation is performed, 
will no longer be available to the program having been displaced by In computing 

the scaling factor f g , $ gik will become and will become Angular 

fluxes and currents must also be extrapolated to correspond to the extrapolated scalar 
fluxes. For the angular boundary flux, the scalar fluxes at the midpoint of the corre- 
sponding mesh interval will be used in the computation of the extrapolation factor. This 


factor is ^ 

from the relation 


.. /$P. 

ik/ giK 


$ 


gik 


the scaled flux 


Since ^ 
*gik + <“ - 


is no longer available, it must be obtained 

With f being the scaling factor and 


$ S , = f $ e , = { E $P = f E nijs 
gik g gik g ik gik f g E ik 


♦ (<■> - 


gik 


co 


and 
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E ik* 




*hk + < w - ‘>*£2 


Using gives the scaled extrapolated currents as 


J 83 = f E., J p 

r gft E * r gik 


and 



■ W? 


gik 


and similarly the angular boundary fluxes. 

The best value of the acceleration factor to is usually not known (ref. 13). There- 
fore, estimates of to must be made by some means (such as previous experience with 
similar problems) while being careful not to overestimate the amount of acceleration that 
can be used for a given problem. Otherwise instabilities may be introduced into the flux 
iterations. The overrelaxation factor should be chosen smaller for less converged prob- 
lems than for more converged problems. This factor is also dependent on the reactor 
system under study. As the rate of convergence decreases and as the problem becomes 
more converged, the acceleration may be increased. A method for performing this 
operation is that of Wachspress as described in reference 12. In this method, new ac- 
celeration factors co* >+ * are computed as convergence proceeds that depend on the origi- 
nal factors o>q and the rate of flux convergence so that 


c-P* 1 - ? 

1 + ^1 - a 2 


( 28 ) 


where 


a 2 + (w Q - 1) 

a = 

™0 


and 
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a 






i,k 


Two types of acceleration may be applied to the outer iterations. One of these is 
overrelaxation while the other is up-scattering scaling. Overrelaxation of the scalar 
flux is applied immediately after the inner iterations in a given lethargy group have been 
completed. The extrapolated flux is given by *gik = - (« - 1 ) $ gik 1 ' This group 

flux is used immediately for computing the down -scattering source but updating the fis- 
sion source is deferred to the end of the outer iteration. Acceleration of the fission 
source after each outer iteration occurs through the use of the extrapolated fluxes. The 
currents and angular boundary fluxes must also be accelerated as in the inner iterations 
for a group. The acceleration parameter o> used will usually be less than that used for 
the inner iterations as the outer iterations constitute a larger, less converged problem 
than do the inner iterations. 

Since the scattering source into a group is based on the latest flux estimates of the 
group in which the scattering occurs, a down -scattering source (neutrons from energy 
degrading scattering) will also be updated in a given outer iteration before it is used. 
However, an up-scattering source in which the scattered neutrons have a greater energy 
than before the scattering collision will not be updated during the outer iteration. A slow 
rate of convergence results that increases the number of outer iterations required. Scal- 
ing those groups that up -scatter to obtain a better estimate of the up -scattering source 
for the next outer iteration improves the convergence rate. The up -scattering scale 
factor f up is applied in the same manner as the within -group -scattering scaling of the 
inner iterations and is written as 


f up _ 


II 

g=l i, k 


Zsl f V 

k F ik V ik 
K eff 


ZZZ Vik -Z z 




g=l i,k 


g=l i, k 


( 29 ) 


where is the total up-scattering removal cross section for group g, and and 

new ® 

^gik re ^ er *-° fluxes before and after the outer iteration. 
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The preceding discussion considers general methods for accelerating the convergence 
of the inner and outer iterations. However, the problem of determining when the con- 
vergence is satisfactory remains. Two aspects of the problem are to devise general 
criteria to be applied by the program and to list various quantities in the program output 
by which the user can make a judgment about the degree of convergence. The latter 
quantities are described in notes [lO] and [ll] of the section Program Operation in ap- 
pendix A. 

In the TDSN program, convergence of the group source or flux is indicated by the 
program if the following conditions are satisfied. First, the mesh interval for which the 
largest change in the within -group -scattering source occurred as a result of an inner 
iteration is determined. Then the ratio of this change to the total integrated group flux 
is found. This ratio is the first quantity that must satisfy a convergence test and is 
written as 



i,k 


Second, two integrated quantities are determined. One of these quantities 6g is the 
ratio of the integrated change in the within -group-scattering source occuring as a result 
of an inner iteration to the total integrated group flux: 

yu /<&p _ c&p.'jw, 

/ , | g-g ^ gik gik J lk 

«2 = — ( 31 ) 

^®gi* V ik 

i,k 

The other is the ratio of the integrated change in the total group removal to the integrated 
group flux: 



i,k 
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Both 62 and 6g must satisfy a convergence test. Third, if any of the outer boundaries 
are reflective, the leakage across the boundary must satisfy a test. 

Convergence of the outer iterations is indicated by the program if the following con- 
ditions to be tested after each outer iteration are satisfied. First, all the group fluxes 
must be converged as determined by the preceding tests. This is an important criterion 
since the group iterations are stopped after a specified number of inner iterations in a 
given group. Thus, the group flux may not be well converged, and if the group has only 
a small effect on the eigenvalue, the tests on the eigenvalue may terminate the problem. 
Thus, unconverged fluxes could be included in the output for some groups if this test was 

not included. Second, the final growth factor A P must not differ from 1 or its previous 
P-1 

value X by more than some specified amount e: 

6 4 = |\ P - l| < € and 65 = |\ P - A P_1 | < e (33) 

Third, the change 6g in the total integrated scattering loss from one iteration to the next, 
as given by the ratio 


XX s s**Si lv * 

5 6 = *£ 1>k < e (34) 

XX 

g=l i, k 


must satisfy a convergence test. For some problems, for which there is no £gj^ n , the 
scattering loss must match the scattering source. Also, if up-scattering scaling is used, 
the ratio 67 of the total integrated change in the up-scattering source as summed over 
all groups to the total integrated flux must be small: 
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DISCUSSION OF SAMPLE PROBLEMS 


Problems have been selected to illustrate various features of the TDSN program. 
Accuracy was tested by comparing results for homogeneous problems with those of refer- 
ence 2. The effect of increasing the order of quadrature n is illustrated by the change 
in the flux shape with the change in S n for a sample problem. The effect of the accelera- 
tion procedures in TDSN is illustrated by other sample problems. 

Carlson and Bell (ref. 2) examine the accuracy of the S n method by comparing S n 
results for a range of test problems with the results obtained by other methods. For the 
purpose of testing the TDSN program, results for the critical dimension R for uniform 
spheres, plane slabs, and cylinders without reflectors were obtained for two values of c, 
where 



Three groups were used with Sjg moment modified quadrature and 32 intervals. The 
values of c chosen were 1. 1 and 1.6. The cross sections for c = 1. 1 are given in 
table I. Those for c=1.6 used of 0. 6. Table II gives the percent derivation 6 of 

the TDSN results from the exact values quoted by Carlson and Bell. 

Also included in the table are results for plane slabs using the quadrature necessary 
for the cylindrical problems. This quadrature is the same one that would be used with 
two-dimensional problems, and, as the table shows, it has little effect on the plane- 
geometry problems. The percent deviations 6 for the three -group problems using the 
correct quadratures are comparable with those given by Carlson and Bell for one group 
problems in table 5 of reference 2 . 

Figure 1 shows the scalar flux as a function of radius for a one -group cylindrical - 
cell problem with five different material regions. A flat fixed source guess was used in 
the outer region, while the cross sections correspond to the thermal cross sections of a 
sample physical problem. The boundary condition at the outer radius was the isotropic 
return condition. The problem was computed by using moment modified quadratures of 
S2, S^, Sg, S 16 , and S^. The flux shapes for S2, S^, and Sg2 are illustrated, while 
the Sg and S lg results were nearly identical with the S32 result. The S 4 result fol- 
lows Sg 2 quite closely, while S 2 deviates from Sg 2 in the smaller, scattering re- 
gions. 

Three different examples will be used to illustrate the effect of accelerating techni- 
ques on the number of iterations required for convergence. The first illustrates the ef- 
fect of overrelaxation of the inner and outer iteration fluxes on a small one -dimensional 
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Figure L * Relative scalar flux as function of radius for one-group cylindrical-cell problem. 


reflected thermal -reactor problem. The second shows the effect of overrelaxation on a 
two-dimensional problem, and the third shows the effect of up-scattering scaling on a 
multitherm al -group problem. 

To show the effect of overrelaxation, a one -dimensional problem with three regions 
consisting of a cylindrical fueled core, thin aluminum wall, and water reflector was 
chosen with 25 mesh intervals, quadrature and two fast groups and one thermal 
group. This problem was chosen as representative of thermal problems that are usually 
more difficult to converge than fast -reactor problems. Over relaxation was first applied 
only to the fluxes of the inner iterations. The results are given by curve A of figure 2. 
The curve is able to extend beyond w = 2 because TDSN only applies the inner iteration 
acceleration factor where a certain degree of convergence is maintained. Curves C and D 
are the result of also applying over relaxation to the outer iteration fluxes with the value 
of a) for the inner iterations held fixed. 

Curve B is the result of first applying the given overrelaxation factor to the inner 
iterations as soon as the degree of convergence required is attained and then computing 
a new group dependent overrelaxation factor by the method of Wachspress (ref. 12) and 
applying it as soon as a second degree of convergence is attained. 

The number of iterations required for convergence of the fluxes, shown as curve A, 
had a minimum of approximately 56 percent of those required for the unaccelerated prob- 
lem corresponding to point I. For those cases involving overrelaxation of both the inner 
and outer iteration fluxes the minimum was approximately 36 percent of the value shown 
as point I. 

The effect of over relaxation on a two-dimensional problem was obtained by running 
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Figure 2. - Number of inner iterations as function of acceleration parameter. Thermal reactor with three 
groups and three regions. 


two similar problems made up of three radial regions consisting of a cylindrical fueled 
core, thin aluminum wall, and water reflector, and reflected axially about the midplane. 
Each problem contained 33 radial and nine axial mesh intervals with quadrature and 
four fast groups and one thermal group. The first problem was calculated by using o> 
as 1 for both the inner and outer iterations, that is, the unaccelerated case. The second 
problem was calculated by using the method of Wachspress. The number of iterations 
required for convergence of the fluxes for the accelerated case was approximately 67 per- 
cent of those required for the unaccelerated case. 

The effect of up -scattering scaling on a multithermal group problem is illustrated by 
a 15-group one -dimensional cylindrical -cell problem with 10 groups that up-scatter. The 
inner structure of the cell contains rings of fissionable material and absorbing material 
separated by void spaces. One hundred mesh intervals were used to represent the cell, 
and an overrelaxation factor of 1. 3 was applied to the inner iterations. Without up- 
scattering scaling, 3325 inner iterations and 49 outer iterations were required. Using 
the scaling required 915 inner iterations and 11 outer iterations. The problems that 
used up-scattering scaling converged in less than one -third of the time required without 
it. Full -core -radial problems involving flux -weighted cross sections from the cell prob- 
lems converged in about one -half the time if up -scattering scaling was applied. 

CONCLUDING REMARKS 

The most important feature of the TDSN program is the convergence acceleration 
achieved from over relaxation and scaling. Additional savings can accrue by testing group 
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convergence to prevent some groups from being converged to a much greater extent than 
others. 

Sample problems have shown that accelerated problems can converge with about two- 
thirds the inner iterations of a nonaccelerated problem with only overrelaxation of the 
inner iterations and with less than half of the inner iterations of a nonconverged one - 
dimensional problem by using overrelaxation of both the inner and outer iterations. The 
effect of up-scattering scaling on multithermal group problems can also reduce the tim e 
required for convergence to less than one -half of that required without it. 

Another important feature of the TDSN program permits a problem to be ended after 
a given number of inner iterations or a given elapsed time. Any output desired may then 
be obtained no matter what stage of convergence has been reached and a restart binary 
card dump is punched if requested. If it can be determined that the problem is sufficiently 
converged, all the output is available and, if not, the problem can be restarted with the 
restart dump. At restart, the convergence and acceleration parameters and output 
options desired may be changed. 

Details of the TDSN program are given in the appendixes. Appendix A gives the in- 
put instructions, output description, and notes on program operations. Appendix B lists 
portions of the Set A and Set B quadrature tables of reference 2 in the format required 
for TDSN. Appendix C lists the names of program decks required by TDSN along with 
their programming language and a brief statement of their purpose. Appendix D is a 
listing of the program decks, and appendix E presents the input and output of a sample 
problem. 

Lewis Research Center, 

National Aeronautics and Space Administration, 

Cleveland, Ohio, May 2, 1966, 

122-28-03-05-22. 
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APPENDIX A 


TDSN OPERATING INSTRUCTIONS 
Discussion of Input 

The numbers in brackets in the remarks column designate notes in the section 
Program Operation that may be of value to the program user. Each Roman numerical re- 
fers to a new card or to a new subscripted variable that may require one or more cards. 
The symbol * means to use as much of the card and as many cards as necessary to read 
in the subscripted variable. See reference 14 for a description of FORTRAN IV names 
and formats, and reference 15 for a description of the operating system and processor. 

I. Problem identification cards. These cards may contain any numeric or alphabetic 
information in card column 3 to 72. A number in card column one indicates the final 
identification card. (The format is II, IX, 14A5.) 

n. BCREAD control card. 

Quantity Format Card Columns Remarks 

KBCRED 110 1-10 = 0 Read in cards HI to XIX (new problem). 

= 1 Read in BCDUMP for restart instead of 

cards ID to XIX. [1] 

= 2 Read in 2 cards following the first 2 parts of 
the BCDUMP to change some of the controls 
on the problem. These two cards are listed 
as XX and XXI. 

= 3 Read in 3 cards following the first 2 parts of 
the BCDUMP. The first 2 are the same as 
those for KBCRED = 2, while the third card 
changes the output to be obtained and is the 
same as card VII. 

If KBCRED equals 0, go to card HI; if it is equal to 1, go to card XXIII; if it is equal to 
2 or 3, go to card XX. 

IQ. Control card. 

KREG 110 1 -10 = 0 A regular flux calculation is performed. 

= 1 An adjoint calculation is performed. 
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• 

Quantity 

Format 

Card columns 

KALC 

110 

11-20 = 1 

KGEO 

no 

21-30 = 1 

KLBC 

no 

= 2 
= 3 

31-40 = 0 

KRBC 

no 

= 1 

41-50 = 0,1 

KBBC 

no 

= 3 

51-60 = 0,1 

KTBC 

no 

= 4 

61-70 = 0,1,3 

IV. Control card. 


NSN 

no 

1-10 

NG 

no 

11-20 

NR 

no 

21-30 

NZ 

no 

31-40 = 0 


= 1 

> 1 


NMAT 

no 

41 -50 

NTYPS 

no 

51-60 


Remarks 

Calculate the multiplication constant k e ^ 
as the eigenvalue (only option available). 
Slab x,y geometry 
Cylindrical r,z geometry 
Sphere r geometry 

No return current, left boundary condition 
Plane mirror (’’perfect”) reflection, left 
boundary condition 

Same as KLBC for right boundary condition 
Isotropic (’’white”) reflection, right bound- 
ary condition [2] 

Same as KLBC for bottom boundary condi- 
tion 

180° rotational symmetry, bottom boundary 
condition [2] 

Same as KRBC for top boundary condition 


This is the order n of S„ to be used. It 

n 

must be an even integer. 

The number of energy groups 

The number of mesh intervals for the first 

direction [3] 

A one -dimensional calculation will be per- 
formed with one -dimensional quadrature 
(for slabs and spheres only). 

A one -dimensional calculation will be per- 
formed with two-dimensional quadrature 
(for slabs and cylinders only). 

The number of mesh intervals for the second 
direction of a two -dimensional calculation 

[3] 

The number of different materials to be 
used [4] 

The number of cross section types per ma- 
terial per group [5] 
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Quantity 

Format 

Card columns 

N2N 

110 

61-70 = 1 

V. Control card. 


KCTYP 

no 

1-10 = 0 
= 1 

= 2 

KSISO 

no 

11-20 = 0 
= 1 

KGST 

no 

21-30 

KCTR 

no 

31-40 

KCGG 

no 

41-50 

NBUCK 

no 

51-60= 0 


= -1 


= 1 


LBUCK 110 61 -70 = 0 


Remarks 

Read in total out -scattering cross sections 
along with the other cross sections for 
KCTYP= 1 or at XVI(4) for KCTYP ^ 1. [6] 


The cross sections will be in TDSN format 
[5] 

The cross sections to be supplied in the 
format of the RP1 diffusion -theory program 

[ 7 ] 

The cross sections to be supplied in the 
format of the DTF and DDF programs [5] 

All materials use only P^ cross sections. 
At least one material uses P^ cross sec- 
tions . 

The number of the group to begin the outer 
iteration. Almost always 1 (the highest 
energy group) for KREG = 0 and NG for 
KREG = 1. 

The position of 2* (or 2* r ) for g = 1 in 

the cross -section matrix. [5] 
st 

The position of 2 in the cross section 

_ i 6 6 

matrix. [5] 

No buckling of this type is to be used. 
Buckling dimensions to be read in by card X 
and the KCTR field of P., scattering cross 
section sets should contain 2^ . [5] and [8] 
Buckling -loss cross sections are to be read- 
in for NMAT materials along with the cross 
sections for KCTYP = 1 or at XVIII for 
KCTYP ^ 1. 

No buckling of this type is to be used. 
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Quantity Format Card columns 

= -1 


= 1 


VI. Control card. 


ITMIMX 

110 

1-10 

ITMIGM 

no 

11-20 

NZONER 

no 

21-30 

NZONEZ 

no 

31-40 

KDREAD 

no 

41 -50 = 0 



= 1 

KFLUXI 

no 

51-60= 0 


= -1 


Remarks 

Print and punch in the output the buckling - 
loss cross sections in the first direction to 
be used later as the buckling -loss cross 
sections in the second direction of another 
problem run in a direction normal to the 
first problem . 

Read -in the buckling -loss cross sections for 
the second direction as given by a previous 
problem at XVII, and print and punch in the 
output the buckling -loss cross sections in 
the first direction as for LBUCK = -1. 


The maximum number of inner iterations to 
be allowed before the problem is stopped; 

4000 will be used if zero is supplied here 
[10] and [11] 

The maximum number of inner iterations to 
be allowed in a group per outer iteration; 

20 will be used if zero is supplied here. 

[9] and [11] 

The number of input zones for the first direc- 
tion [12] 

The number of input zones for the second 
direction (zero if NZ = 0 or 1) [12] 

Use moment modified quadrature for direc- 
tion cosines and weights as calculated by 
program. 

Read -in direction cosines and weights at 
XV. 

Use an initial flux guess of constant value 
over all mesh intervals and groups as sup- 
plied by the program. 

Supply a binary card dump of the fluxes of a 
previous problem that had the same number 
of mesh intervals and groups for the initial 
flux guess. This is done at XIX (1). [1] 
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Quantity 


Format 


Card columns 


Remarks 




= 1 

Supply an initial flux guess at XIX(2) 

KALC1 

110 

61-70 

To be used for KALC > 1 (not available at 
present). 

VH. Control card. 



GLAM 

E10.6 

1-10 

The value of X to be used for problems 
other than KALC = 1. On restart, the final 
value of X of the previous run is given in 
the output. 

EIGEN 

E10.6 

11-20 

The eigenvalue to be used for problems 
other than KALC = 1. On restart, the final 
estimate of the eigenvalue of the previous 
rim is given in the output. 

EPS 

E10.6 

21-30 

The convergence criteria for the outer itera- 
tions [10] 

XNF 

E10.6 

31-40 

The normalization factor; the number of fis- 
sion neutrons at the beginning of an outer 
iteration is normalized to XNF. 

RYF 

E10.6 

41-50 

The ratio factor used in one of the conver- 
gence checks as listed in note [10] 

TIMAX 

E10.6 

51 -60 

The maximum time in minutes for a problem 
to be allowed to run. The problem will be 
stopped after the outer iteration, in which 
TIMAX was exceeded, has been completed. 
Enough time should be allowed on a system 
time card to complete an outer iteration and 
give all the output requested. If it is zero, 
1. 5 minutes will be used. [10] and [11] 

CALC1 

E10.6 

61-70 

To be used in conjunction with KALC1. 

vm. Control card. 



OMEGA 

E10.6 

1-10 

The relaxation parameter to be used for in- 
ner iterations. It is not used unless 
KACCEL ^ 0. OMEGA > 1 for overrelaxa- 
tion. [11] 
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Quantity 


Format 


Card columns 


Remarks 


OMEGAP E10. 6 


KACCEL 110 


KUPS 110 


IX. Output control card. 
ITMPRT 110 


KBCDUP 110 


11-20 


51-60 = 0 


= ±1 
= ±2 


61-70= 0 

>0 


The relaxation parameter to be used in ac- 
celerating the outer iterations. It is not 
used unless KACCEL = ±2. [11] 

No acceleration of the inner or outer itera- 
tions 

Relaxation of the inner iterations [11] 
Relaxation of the inner and outer iterations; 
-1 or -2 to calculate for the inner 

iterations by the method of Wachspress 
(ref. 12) [11] 

Up-scattering scaling will not be performed. 
Scaling of the outer iteration fluxes for those 
groups that up -scatter will be performed. 


1-10 = 0 
= 1 


= 2 


= 3 


11-20 = 0 


= -1 


No intermediate output is to be printed. 

A two -line edit of each outer iteration is to 
be printed. 

In addition to the preceding, a line edit that 
gives the inner iteration relaxation parameter 
to be applied during the next inner iteration 
in a given group along with convergence data 
is to be printed. This is given if overrelaxa- 
tion was applied during the iteration. 

In addition to the preceding, all the negative 
angular fluxes calculated during the last in- 
ner iteration in each group are printed out 
along with the corrections applied. The 
group scalar fluxes must be within approxi- 
mately a factor of 10 of meeting the conver- 
gence criteria for the print out to be given. 

No binary card dump will be punched. 

A binary card dump of the scalar fluxes will 
be punched for the last outer iteration per- 
formed. It is to be used in another problem 
with KFLUXI = -1 . [1] 
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Quantity 


Format 


Card columns 


Remarks 


= 1 A binary card dump for restart will be 

punched if the problem stops before the outer 
iterations are converged (see II . p. 40). 

[1] and [10] 


KACAV 


110 


= 2 


21-30 = 0 


= - 1,1 


= - 2,2 


= -3,3 


Same as KBCDUP = 1, except that the card 
dump will be given even if the problem is 
converged. [1] and [10] 

No activity or averaging tables is to be given 
in the output. 

Activity tables will be given in the output 
along with disadvantage factors. 

Averaging tables will be given in the output 
and punched. These tables give flux- 
weighted average cross sections by the zones 
requested plus a set averaged over all zones 
(only given if KREG = 0). [13] 

Both sets of tables will be given 


If KACAV > 0 is used, the zones will be by material, and if KACAV = 2 or 3, only the 
set averaged over all zones will be punched. If KACAV < 0, a separate zone map for 
each type of table requested must be read in at XXIV. 


KGAVE 110 31-40 = 0 

>0 


KNIP 110 41-50 =0 

= 1 


No group collapsed cross sections will be 
given. 

The number of groups of collapsed cross 

sections. The identification numbers must 

be read in at XXIH. Punched output is given. 

If averaging tables are requested, the same 

zones will be used. If averaging tables are 

not requested, the collapsing will be done by 

materials. The collapsed cross section 
st 

will not be correct if n — 2n scatter- 
ing is present (only given if KREG = 0). [13] 
No flux integrals are punched or effective 
axial bucklings printed in the output. 

The fluxes as integrated for each material 
are printed and punched by group for each 
material. 
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Quantity Format Card columns Remarks 

= 2 Same as KNIP = 1 plus the axial leakage 

probability per unit flux (axial leakage/flux) 
is printed by group for a two- 
dimensional problem. 

KEDIT 110 51-60 = 0 EDIT subroutine will not be used. The EDIT 

subroutine gives activities, flux integrals, 
and flux -averaged cross sections over groups 
and mesh intervals to be specified at XXV(2) 
for cross sections as specified by KEDIT. 

= 1 Cross sections by group to be used by the 
EDIT subroutine must be read in at XXV (3) 

= 2 The EDIT subroutine will use the absorption 
cross section of the problem. 

= 3 The fission neutron cross section of the 
problem will be used. 

= 4 The total (or transport) cross section of the 
problem will be used. 

X. Buckling dimensions. This card is a part of the input only if NBUCK = -1. 


HZ 

E10.6 

1-10 

The first buckling dimension which is the 
second dimension of a one -dimensional prob 
lem and the third dimension of a two- 
dimensional problem. 

HY 

E10.6 

11-20 

The second buckling dimension should be 
zero except for one -dimensional slabs. 

BF 

E10.6 

21-30 

If buckling factor is zero, n/ -/3 will be 
used. [8] 

XI. Specifications for first dimension. 
NZONER input zones. 

One card of this type is included for each of the 

NMI 

15 

1-5 

The number of mesh intervals in the zone 

RMI 

E10.6 

6-15 

The distance from the left boundary of the 
problem to the outside boundary of the zone 

MID 

15 

16-20 

The material identification of the zone (not 
used if NZONEZ is greater than 1 [4] 
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XII. Specifications for second dimension. (No cards are included here unless NZ is 
greater than 1.) One card of this type is included for each of the NZONEZ input zones. 

Quantity Format Card columns Remarks 

NM I 15 1 -5 The number of mesh intervals in the zone 

RMI E10. 6 6-15 The distance from the bottom boundary of the 

problem to the upper boundary of the zone 

XIII. Material specifications for problems for which NZONEZ is greater than 1. (No 
cards are included here unless NZONEZ is greater than 1.) One card(s) of this type is 
included for each of the NZONEZ input zones. 

The material identification as described in 
note [4]; NZONER values are included per 
card(s). 


NG values are included to give the fission 
spectrum x by energy group. The sum 
should be 1 . 

XV. Direction cosines and weights. (No cards are included here if KDREAD = 0.) ND 
values are included for each function. [14] 

(1) DR 7E10.6 1-10, * The direction cosines to the first direction 

(2) DZ 7E10.6 1-10, * The direction cosines to the second direction 

(no cards are included if NZ = 0 or 1). 

(3) W 7E10. 6 1 -10, * The direction weights (which must add to 1). 

XVI. Cross sections for each material included here. 

(1) If KCTYP = 0, use this format. NG sets of cards for each material (P^ mater- 
ials counting as 2 materials) are included here with a set covering only one energy group. 

C 7E10.6 1-10,* See note [5] for description. 

(2) If KCTYP = 1, use this format. Three different sets of cards may be included for 
each material. [7] 

(a) The first set of cards is given as follows and contains NG cards: 


MID 7110 1-10,* 

XIV. Fission spectrum. 

XKI 7E10.6 1-10,* 
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Quantity 


Format 


Card columns 


Remarks 


D 

E10.6 

1-10 

2 a 

E10.6 

11-20 

2 r 

E10.6 

21-30 


vX l E10.6 31-40 

BUCKG E10.6 41-50 


I 

(b) If NDOWN 
of cards consists 
eluded here. 

s down 7E10.6 1-10,* 


The diffusion coefficient 

The absorption cross section that will be put 

in the C a position. 

K (NTYPS - KCGG) = 1, this is the scatter- 
ing removal cross section and will be put 
into the first (and only) c < * own position. If 
N2N = 1, this is the total out -scattering 
cross section CN2N. [6] 

The fission neutron cross section that will 
be put in the C* position 
If NBUCK is greater than zero, the effective 
buckling cross section is included here. 
When multiplied by the flux it will yield the 
transverse leakage. 


2 g-g+l’ 3 * S g-g+2’ S g-g+3’ etc ' ’ xmtil either 
NDOWN values have been given or 

has been reached. 


= NTYPS - KCGG is greater than 1, or if NUP > 0, the second set 
of the down -scattering cross sections for the material and are in- 


(c) If NUP = KCGG - (KCTR + 1) is greater than zero, the third set of cards con- 
sists of the up-scattering cross sections for the material. The cross sections start 
for the scattering out of the (NG - NUP + l)-th group to the NS * (NG - NUP)-th 
group. 


S 7E10.6 1-10,* S g-g-l’ S g-g-2’ etc - » unti 1 s g ~NS has 

been reached. 

The cross sections for the next material are then given. In each case the cross 
sections are put in positions as specified by note [5] by the program to work the 
problem. Also is computed for each material and put in the C g ~® position. 

No activity cross sections can be included. [7] 

(3) If KCTYP = 2, use this format. The order of the cross sections on the cards is 

the same as that for XVI(l), but the cross sections are divided into sets only by material 

and not by material and group with C act for the next group (C a if KCTR = 3) beginning 
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in the next field following the final down -scattering cross section of a given group. The 
format is 6F12. 7. This is the same format as used by DDF and DTF (ref. 16). [5] 

(4) If N2N = 1 and if KCTYP ^ 1, the total out scattering cross sections are supplied 
here before the next material is included under (1) or (3). 

Quantity Format Card columns Remarks 

CN2N 7E10.6 1-10,* NG values [6] 

XVH. Effective buckling cross sections if LBUCK = 1 included here. 

BUCLK 7E10. 6 1 -10, * NG values of BUCLK are given. Each value 

when multiplied by the flux will yield the 
transverse leakage by group. 

XVIH. Effective buckling cross sections if NBUCK = 1 included here for KCTYP ^ 1. 
NMAT sets of cards are included. XVII and XVm should not both be used for the same 
problem. 

BUCKG 7E10.6 1-10, * NG values of BUCKG are given in each set. 

The second set for Pj materials should 
contain zeros. Each value when multiplied 
by the flux will yield the transverse leakage 
by group and material. 

XIX. Initial flux guess (no cards are included if KFLUXI = 0). 

(1) The binary card dump of the fluxes of a previous problem with the same values of 
NG, NR, and NZ is included here if KFLUXI = -1. 

(2) If KFLUXI = 1, the flux guess is included here. 

N,X 5(15, E10. 6) (1-5,6-15), * N is the number of successive intervals at 

which to use X for the flux guess. The sec- 
ond value of N (appearing in card columns 
16 to 20) gives the number of successive 
intervals at which to use the next value of X 
(appearing in card columns 21 to 30), and so 
forth. If N becomes zero before NR times 
NZ values have been given, the remaining 
values for the flux guess are set equal to 
zero for the group. Repeat for other groups 
as desired. 
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If KBCRED = 0, go to XXIII since the following cards are used only for a restart. 
XX. Restart control card for KBCRED = 2 or 3. 


Quantity 

Format 

Card columns 

Remarks 

ITMIMX 

no 

1-10 

Same as for 

card VI [11] 

ITMIGM 

110 

11-20 

Same as for 

card VI [11] 

XXI. Restart control card for KBCRED 

= 2 or 3. 


EPS 

E10.6 

1-10 

Same as for 

card VII 

TIMAX 

E10.6 

11-20 

Same as for 

card VH [11] 

OMEGA 

E10.6 

21-30 

Same as for 

card Vm [11] 

OMEGAP 

E10.6 

31-40 

Same as for 

card Vm [11] 

KACCEL 

no 

51-60 

Same as for 

card Vm [11] 

KUPS 

no 

61 -70 

Same as for 

card Vm 


XXR. Restart output control card for KBCRED = 3. This card is included only if 
KBCRED = 3 and is the same as card IX. 


The following cards are for special edits and are utilized only after the problem has been 
completed. 

XXm. Collapsed group identification numbers. Cards are included here if KGAVE > 0. 


IDGP 7110 1-10,* Include NG numbers identifying the KGAVE 

collapsed group to which each group belongs. 


XXIV. Activity table and flux -weighted averaging table identification numbers (cards are 
needed if KAC AV is negative) . 

(1) The map for the activity table. Cards are needed if KACAV = -1 or -3. 


(a) The number of output zones 


NZONRA 

no 

1-10 

NZONZA 

no 

11-20 


The number of output zones in the first direc 
tion (maximum of 50). [12] 

The number of output zones in the second 
direction (zero for a one -dimensional prob- 
lem; (maximum of 30). [12] 


(b) Mesh interval map. 
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Quantity 

Format 

Card columns 

Remarks 

NMRA 

7110 

1-10,* 

The number of mesh intervals for the first 
direction to be included in each output zone. 
Include NZONRA values. 


(c) Include this card if NZONZA > 0. 


NMZA 7110 1-10, * The number of mesh intervals for the second 

direction to be included in each output zone. 
Include NZONZA values. 

(d) The identification numbers for the zones. Include NZONZA sets of cards (one 
set if NZONZA = 0). 

IDM 1415 1-5,* Include NZONRA values per set of cards 

identifying which zones (and thereby mesh 
intervals) are to be combined in obtaining 
the activity table. Zones with the same 
value of IDM will be combined. 

(2) The map for the averaging table. No cards are included here unless 
KACAV = -2 or -3. If KACAV = -3 both XXIV(l) and XXIV (2) must be included. The ex- 
planation of the input is the same as under XXIV(l). 

XXV. Input for EDIT subroutine if KEDIT > 0. 

NISET 110 1 -10 The number of activity edits (integration sets) 

to be performed. 

(1) The number of integrals to include in a given edit set (INT has a maximum of 200). 

INT 110 1-10 This card will be read in NISET times. 


Cards (2) and (3) are included in order INT times following each card (1). 
(2) The integration limits for a given integral. 


IG1 

110 

1-10 

The upper limit of the groups to be included 
in a given integral 

IG2 

110 

11-20 

The lower limit of the groups 

IR1 

110 

21-30 

The left limit of the first direction mesh in- 
tervals to be included in a given integral 
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Quantity Format 


Card columns 


Remarks 


IR2 

no 

31-40 

The right limit 

IZ1 

110 

41-50 

The lower limit of the second direction mesh 
intervals to be included in a given integral 
(one for a one -dimensional problem). 

IZ2 

110 

51-60 

The upper limit (one for a one -dimensional 
problem) 

(3) Include this card 

only if KEDIT = 1. 


SIGMA 

F10.6 

1-10 

The group cross section to be used in the 


integration. Include one value (on separate 
cards) for each group within the limits IG1 
and IG2. 


Description of Output 

Each Roman numeral refers to a new section of output. The numbers in brackets 
again refer to notes in the section Program Operation. 

I. Input title and control cards. LAST is the storage required for the subscripted 
variables of the 17 500 available, and LAST1, LAST2, LAST3, and LAST4 are 
the storages required by each of the first four overlays for these variables. 

II. Dimension specifications by zone as included in input and by mesh interval as calcu- 
lated by program. Only the latter is given on restart from a binary card dump. 

HI. Material specifications MA by mesh interval beginning with lower left mesh 
interval. [3] 

IV. Fission spectrum input x> XKI. 

V. All cross section input in TDSN format. If KCTYP = 1, this is preceeded by the 
cross sections in their input format. Only the TDSN format is given on restart. 

VI. If LBUCK = 1, effective buckling cross sections BUCLK are listed; if NBUCK = 1, 
effective buckling cross sections BUCKG are listed. 

VII. Total out -scattering cross sections are listed by group. 
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Vin. Volumes of mesh intervals as calculated by program are listed beginning at 
lower left corner. [3] 

IX. Direction functions as included in input or as calculated by program are listed. 

X. If ITMPRT > 0, two lines of intermediate output for each outer iteration are 

listed. The output listed is as follows for the first line: 


ITMA 

ITMI 

ITMIGX 

ITD 

TIME REQ 

EPG 

EPGM 


KASOR 


KONV 


KFINSH 
NEUTRON BAL 


GLAM 

EIGEN 


Number of outer iteration 

Total number of inner iterations performed [11] 

Maximum number of inner iterations performed in a group 
during outer iteration 

Number of inner iterations per outer iteration 

Total time required to perform iterations in minutes; time 
starts over on restart [11] 

Convergence criterion for inner iterations [9] 

Maximum change in within -group -scattering source (or in the 
collision removal) that has occurred for last inner iteration 
in a group [9] 

If KSISO = 1, KASOR > 0 indicates an adjustment was made to 
Pj source for final inner iteration in a group; value of 
KASOR is number of groups in which adjustments were 
made; KASOR must be zero for convergence 

Equal to 0, problem unconverged and continuing to rim; equal 
to 1, problem unconverged but stopped by iteration count 
(ITMIMX); equal to -1 , problem unconverged but stopped 
by TIMAX; equal to 2, problem converged [10] 

Number of groups that did not converge during the inner itera- 
tions (see XIV. [9] and [11]) 

Neutron balance as given by note [6]; if large, after con- 
vergence, an error such as in cross sections or in setting 
a large number of negative angular fluxes to zero is indi- 
cated 

Eigenvalue X that must be within EPS of 1 for convergence, 
and within EPS of previous value of X 
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The second line of the two -line output is as follows: 


UPS2 


XNG(NGP1) 

SING(NGP1) 

SDG(NGP1) 

AG(NGP1) 

HNLG(NGP1) 

VNLG(NGP1) 

XNLG(NGP1) 


Up -scattering error; sum of absolute change in up -scattering 
source over all mesh intervals and groups from before 
and after an outer iteration; not used if KUPS = 0 [9] 

Total flux over all mesh intervals and groups 

Total in -scattering source over all mesh intervals and 
groups [9] 

Total out -scattering loss [9] 

Total absorption [9] 

Total leakage along first direction [9] 

Total leakage along second direction [9] 

Total leakage including HNLG, VNLG, and any buckling 
losses [9] 


XI. If ITMPRT > 1, the following line is listed during each inner iteration in which 
overrelaxation has been applied: 


GROUP 

ITMIG 

FLUX ERROR 


ERROR RATIO 

FORMER RATIO 
FACTOR 


OMEGA 


Group to which acceleration was applied 

Inner iteration for which acceleration was applied 

If KACCEL > 0, this is the larger of 6 2 and 63 (EPGX) 

(see note [9]) of previous iteration of group; if 
KACCEL < 0, this is the integrated absolute change in 
scalar flux that occurred during present iteration 

i,k 

o 

If KACCEL < 0, this is a of equation (28) which is ratio of 
present FLUX ERROR to previous iteration FLUX ERROR 

If KACCEL < 0, this is ERROR RATIO of previous iteration 

If KACCEL < 0 and two ratios are within 0. 005 of being 
identical, this is the parameter a of equation (28) that 
is used to compute new overrelaxation factor . 

Value of overrelaxation factor a> 1>+ * to be used for next 
inner iteration in group 


55 


XII. If ITMPRT = 3, information will be printed out if negative values are obtained in 
applying the recursion relation to obtain angular fluxes at mesh cell and quadra- 
ture boundaries. This information is only printed out if the group scalar fluxes 
are within about a factor of 10 of convergence and for the last inner iteration in 
a group. The information given is a number indicating the type of angular flux 
that was negative (1310 for mid-mesh cell, mid -quadrature fluxes, 1340 for 
fluxes on the second -direction boundaries of mesh cells, 1355 for those on 
quadrature boundaries, 1375 for those on first -direction mesh-cell boundaries 
on inward passes, and 1390 for outward passes), the value that the flux was ad- 
justed to, the value it had before being adjusted, the quadrature direction in- 
volved, the mesh interval involved (starting with 1 in the lower left corner and 
ending with NR times NZ for the upper right corner), the lethargy group in- 
volved, and the number of the inner iteration being performed. 

XIII. The first line of the output described under X is listed for the final outer iteration 

performed. 

XIV. If KFINISH > 0, NG values of KFING are listed indicating the status of each group. 

A zero means the group converged, -1 means EPGX for the group was less than 
one-twentieth of the previous outer iteration EPGM, 1 means that the number of 
group iterations had become equal to the maximum allowed. [9] 

XV. If KASOR > 0, NG values of KASORG are listed indicating the number of mesh 

intervals in each group at which an adjustment was made in the P^ source. 

XVI. The mesh interval in which the greatest change in the within -group-scattering 

source ESIJM occurred for the last inner iteration is listed under MXVARI. [10] 

XVII. This mesh interval listing is followed by the values of ESIJM which is the ratio of 
the actual change in the within-group-scattering source to the flux integral for 
the group. 

XVHI. A number of labeled quantities are listed next by group with the last value being 
the sum over all the groups. Each quantity represents a sum over all the mesh 
intervals. Many of the quantities lose their meanings for an adjoint calculation. 

XIX. The next set of quantities (F, XN, XJR, and XJZ) are listed by mesh intervals and 
have been normalized so that the maximum value of the flux will be 1. The re- 
ciprocal of the maximum value of the flux is listed first as the normalization 
factor. 
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(1) F Production rate per unit volume 

(2) XN Scalar flux $ by group 

(3) XJR If KSISO = 1 , the current in the first direction is given by group. 

(4) XJZ If KSISO = 1 and the problem is two dimensional, the current in the 

second direction is given. 

XX. If KNIP = 1, flux integrals over the range of each material will be listed and 

punched on cards (in 7F10. 6 format). (For the Pj portion of Pj materials, 
the net two-dimensional current integral is listed and punched. ) If KNIP = 2, 
the effective buckling cross section for the transverse direction is also listed by 
group. This is the leakage in the transverse direction divided by the flux as 
integrated over all mesh intervals. 

XXI. If LBUCK = -1 or 1, an effective buckling cross section for the first direction is 
listed and punched (in 7F10. 6 format) by group. This is the leakage in the first 
direction divided by the flux as integrated over all mesh intervals. 

XXII. If KACAV = -3, -1, 1, or 3, activity table output will be listed. 

(1) If KACAV is negative, the activity table input map is listed by mesh inter- 

val. 

(2) An activity table for each region specified by the activity table map (either 

as at XIX(l) or as at HI) with negative identifications yielding successive 
Pq and P^ activity tables. Then a table for all the mesh intervals 
specified by the map is presented (one for P Q and one for Pj if 
KSISO = 1 and negative identifications have been included in the map. ) 
These tables are integrals of S$V (2JV, if Pj) for each region listed 
and for each cross section 2 included in the input and are listed in the 
same format as that used for the TDSN cross sections. The fina l value 
for each group is the flux integral for the group. The final line (or set of 
lines) is the sum over all the groups. The flux $ used for the scattering 
cross sections is that required to obtain the source. 

(3) Disadvantage factors are listed by group for each region. These are the 

ratio of the flux integral for the region to the volume of the region divided 
by the ratio of the total flux integral to the total volume or 
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where ^ ' means to sum over those mesh intervals 
i,k 

region m. 


i, k contained in 


XXm. If KACAV = -3, -2, 2, or 3, averaging table output will be listed and punched 

and/or, if KGAVE is greater than zero, collapsed group output will be listed and 
punched (only if KREG = 0). 


(1) If KACAV is negative, the averaging table input map is listed by mesh inter- 

val. 

(2) Averaging tables similar to the activity table described by XXII(2) are 

listed. These are flux -weighted tables. If Pq and P^ material re- 
gions are combined, the average 2* obtained will be a combination of 
the 2* of the Pj region and the 2 tr of the P Q region. This will also 
occur in the final table covering all the mesh intervals in the map. If 
KACAV is negative, punched cards are also given for each region and for 
the final combined region. If KACAV is positive, punched cards are 
given only for the final combined region since the cross sections for the 
other regions will be just like the input. [13] 

(3) If KGAVE is greater than zero, the collapsed group identification numbers 

are listed. 

(4) If KGAVE is greater than zero, collapsed group cross sections are listed 

and punched for each region in the map. [13] 


XXIX. If KEDIT is greater than zero, the edit output is listed. 

(1) Edit input is listed for each integration set. 

(2) For each integration set, the activity, flux integral, and flux -weighted 



cross section (activity/flux integral) are listed for each specified integra- 
tion limit along with the final values for the entire set. 


Program Operation 

[1 J The binary card dump for restart consists of three dumps. The first of these is 
the program COMMON (ref. 14) and contains 10 cards. The second dump contains the 
subscripted variables required for restart except for the fluxes and currents. The num- 
ber of cards depends on the problem. The third dump contains the fluxes and currents. 

If KSISO = 0, only fluxes will be given and the number of sets of cards will be NG. These 
cards may also be used for the flux guess with KFLUXI = -1. If KSISO = 1, the sets con- 
sist of the fluxes (XN), first -direction currents (XJR) and, if NZ > 1, the second- 
direction currents (XJZ) for each group in order. Thus, if the fluxes are desired for a 
flux guess they must be separated from the currents. 

[2] Plane mirror reflection represents a symmetry boundary condition that does not 
apply to curved outer boundaries. Isotropic reflection is more realistic for many cell 
problems (ref. 5), and its use is recommended for curved boundaries. 

For 180° rotational symmetry, the mesh below the diagonal must be such that it can 
undergo a rotation through 180° about the midpoint of the configuration and duplicate the 
mesh above the diagonal. Taking advantage of the symmetry by solving only that portion 
of the configuration above the midpoint requires that the mesh spacings in the first direc- 
tion must be symmetric about the midpoint of the new bottom boundary . 

[3] The number of mesh intervals required can be determined by a rule given in 
reference 2. This rule states that the ratio of the average flux for adjacent mesh inter- 
vals to the absolute difference of these fluxes should be approximately equal to the order 
of quadrature n for important regions and groups. For instance, for S 4 the ratio 
should be approximately 4. If the ratio is much smaller than n, too few mesh intervals 
have been used, and if it is much larger than n, more mesh intervals than required have 
been used. 

Another criteria has been that 2* Ar or 2* Az should be less than or equal to 1 . 
However, this criterion seems to be unnecessarily stringent and has not been required 
for problems calculated by the author. 

The mesh layout for a two-dimensional problem is given in figure 3 that shows the 
mesh numbering scheme used. 

[4] The materials are identified by the order in which they occur in the input with 
the Pj matrix of Pj materials counting as a separate material. Thus, the total num- 
ber of materials NMAT equals the number of Pq materials plus twice the number of Pj 
materials. 
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Figure 3. - Mesh layout showing 
mesh numbering scheme. 


To identify the material to be used in a given input 
zone (MED), the position in which it occurs in the input is 
used. 'P 1 materials are identified by using the negative of 
the input position for MID. For example, if the fifth set of 
cross sections in the input is a Pj material, it would be 
identified by -5 for MID. This would mean that the sixth 
set of cross sections would be the Pj scattering matrix 
for material 5. The next allowed value of MID would be 7. 
If material 5 is the last material to be included in the input, 
NMAT becomes 6 to correspond to the number of sets of 
cross sections in the input. 

for S n programs have usually been arranged in the following 
The first cross sections (if any are used) for the group are 


[5] Cross sections C 
order for any one group 

known as activity cross sections 2 g ct and are only used in the program output in the 
tables in flux integrations such as 


!,v-/ 

•'vr 


2 act $ 

g,v 


g>v 


dv 


Following the activity cross sections (or the first in order if there are no activity 
cross sections) comes the absorption cross section 2 a . This cross section is used to 
compute neutron balance but is not used in the actual flux iterations. 

In the next field occurs v times the fission cross section v2 g followed by the total 
cross section 2* (or 2 g r if the transport approximation has been used). The field con- 
taining is designated by KCTR. 

The 2 a and i/E g fields are not used for the P^ scattering cross sections of a Pj 
material and neither is the S g field unless a buckling cross section based on the reactor 
dimensions (NBUCK = -1) is to be obtained. Then this field should contain £ g r to be 
used in obtaining the buckling cross section. 

The scattering cross sections in the usual S n order represent the scattering into 
the group rather than the scattering out of it. Positions for the same number of cross 
sections are allowed in each group so that there are fields provided for some nonexistent 
cross sections and these should contain zeros. The field containing the within -group- 
scattering cross section 2 g __ g is designated by KCGG, while the total number of fields 
required for all the cross section input for any given group is given by NTYPS. 

If there is any up-scattering, the number of fields allowed for each group is 
NUP = KCGG - (KCTR + 1) with the 2 g+1 _ g cross section occuring in the field just 
before 2 g , the S g + NUP-g cross section occuring just after 2 g , and the others in 
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order between these two. For any particular group, the cross sections for the left most 
fields (or for all the fields) may not exist. 

The down -scattering cross sections allowed for any group is NTYPS - KCGG with 
the cross section occuring in the field immediately following 2g_^. No down- 

scattering cross sections will exist for the first group and only one for the second group, 
etc. , until all the fields are filled for group NTYPS - KCGG + 1. The entire cross sec- 
tion array over all groups and materials is stored in the program array C. 

For P t material, the first set of cross sections contains 2 act , 2 a , i/2* , 2* , and 
the total scattering array for all groups, while the second set of cross sections contains 
2 act (to be integrated over the current) and the Pj scattering array and sjjf if 
NBUCK = -1. For KCTYP = 0, the 2i + 1 multiplier must be included in the P^ scat- 
tering matrix. For KCTYP = 2, the Pj scattering matrix will be multiplied by 2f + 1 
by the program before being stored in the C array, and the 2£ + 1 multiplier must not 
be supplied in the cross-section matrix. 

[6] If a problem contains materials that involve n — 2n scattering, the total scat- 
tering removal cross section 2* must be included in the problem input as CN2N for use 
in computing the neutron balance. The reason is that the total Pq scattering matrix 
contains the extra neutrons that result from the n — 2n scattering and would yield too 
large a value for neutron loss if it were obtained by summing the scattering matrix as if 
it represented the scattering out of a group. 

The total scattering removal 2^ is defined by 

o 


G 



gVg 


The neutron imbalance per group is computed by the program as the difference be- 
tween the fixed source to the group before the inner iterations for the group and the 
losses from the group by absorption, scattering removal, and leakage from the system as 
computed after the inner iterations. The output quantity XNB(NGP1) is the ratio of the 
sum over all groups of the group imbalance to the "power level" XNF. 

[7] If the cross sections are supplied to the program in the form of diffusion cross 
sections (KCTYP = 1), 2* r and S g_g must be computed and the whole array rearranged 
before being stored in the C array. Both these operations are performed by TDSN: 

2* r is calculated as 1/(3D ), while 2 is computed to give balance as 
o tr nr & t* & o 

= " g ~ where is the scattering removal from the group. If there is 

no n — 2n scattering (N2N = 0), 2^ is obtained by summing the down- and up-scattering 

o 
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out of group g. If there is n — 2n scattering, the scattering removal cross section 
must be included in the input as CN2N (see note [6]). 

Since the cross sections are diffusion program cross sections and are rearranged to 
be transport approximation S n cross sections, Pj scattering cannot be allowed, and 
KSISO must be zero. 

[8] If buckling dimensions are supplied, buckling -loss cross sections are computed 
by the program as 


B 2 s tr 
(2 tr H + 2y) 2 

where B is the buckling factor, H the buckling dimensions, and y = 0. 71045608. The 
buckling factor is 7r/-/3 for plane boundaries and 2(2. 405/ -/3) for cylindrical bound- 
aries. For cylindrical boundaries, H is the diameter. 

[9] The inner iteration convergence in the TDSN program may be seen through 
various quantities listed after each outer iteration and others listed after the last outer 
iteration. . • 

The first of these is EPGM; the largest (considering all groups) of the quantities $2 
and 63 given by equations (31) and (32). If this value of EPGM is larger than EPG, the 
problem is not converged. The amount of change in this quantity from one outer iteration 
to the next is an indication of the rate of convergence. 

If either the top or right boundaries are reflected (KTBC or KRBC equal 1 or 3), the 
leakage across the boundary must be less than EPG/8 for convergence to be indicated. If 
either of these boundaries is not reflected, the values of the total leakage across these 
boundaries (VNLG and HNLG) and of the net leakage (XNLG) summed over all groups is 
of interest in determining the amount of convergence of the boundary fluxes. Changes in 
these leakages as the outer iterations proceed indicate that the fluxes at the boundaries 
have not converged. 

If up-scattering scaling is used (KUPS > 0), 6^ of equation (35) must be less than 
EPS for the outer iterations to be considered converged. This quantity should decrease 
as convergence proceeds and is UPS2/XNG(NGP1). 

Other quantities that may be seen in the output to indicate convergence are 
SING(NGP1), SDG(NGP1) and AG(NGP1). All three should cease to change as convergence 
proceeds and, if KREG and N2N equal zero, SING(NGP1) and SDG(NGP1) should be equal, 
within EPS, for convergence. 

If inner iteration convergence for any group is not indicated for the last outer iter a - 
tion, the inner iterations may have been terminated for either of two reasons . First, 
because EPGX (the maximum of 62 311(1 6 3 of eqs. (31) and (32)) has become less than 
one -twentieth of the previous outer iteration EPGM or second, because convergence was 
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not indicated within the allowed number of inner iterations ITMIGM. The quantity that 
indicates this lack of convergence after each outer iteration is KFINISH; the number of 
groups not satisfying all the convergence tests. Group convergence is required 
(KFINISH = 0) before the problem is considered to be converged. 

[10] The outer iteration convergence in the TDSN program may be seen through the 
quantities listed after each outer iteration, as in note [9], and in quantities listed only 
after the final outer iteration. 

First, the mesh interval MXVARI for which the largest change in the within-group- 
scattering source occurred as a result of the last inner iteration in a group is determined 
and listed. Then 6 ^ given by equation (30), the ratio ESUM of this change to the total 
integrated group flux XNG, is found and listed. This quantity must be less than EPG/100 
for group convergence to be indicated. 

Another quantity listed th^t is concerned with the group convergence is KPTNG which 
gives by group, if KFINISH wasgreater than zero, the reason why the groups were not 
converged. Here -1 indicates that EPGX for the group was one -twentieth of the previous 
outer iteration EPGM, and 1 indicates that all the allowed inner iterations were performed 
for the group. KFING = 0 indicates convergence. 

The outer iteration convergence tests are given by equations (33), (34), and (35) with 
64 , 65 ? and 6rj compared with EPS. However, a form of 6 g given by the ratio of the 
total out -scattering loss SDG to the total fission source FG for the previous outer itera- 
tion divided by the same quantity for the present outer iteration must be within EPS/RYF 
of 1 . 

H these tests are not met, the problem wiU continue unless stopped by either of two 
checks. The first of these is that the total number of inner iterations ITMI exceeds the 
maximum number allowed ITMIMX. The second check is that the elapsed time TIMEX 
required to perform the problem exceeds the maximum allowed time TIM AX. If ITMI 
exceeds ITMIMX, KONV is set equal to 1 and the problem terminates, or if TIMEX ex- 
ceeds UMAX, KONV is set equal to -1 and the problem terminates. In either case, all 
the requested output is then given along with a restart dump if requested by KBCDUP. 

[ 11 ] Certain parameters of the problem can be changed on restart as listed for cards 
XX, XXI, and XXH of the input. They include parameters affecting the problem conver- 
gence such as the number of inner iterations to allow per group (ITMIGM), the amount 

of overrelaxation to use, and the use of up-scattering scaling. 

It is recommended that ITMIGM be smaU (about 10 to 20) initially. This enables the 
fixed portion of the group source to be updated more often and avoids wasting time con- 
verging group fluxes while using a grossly inaccurate source guess. As the source be- 
comes converged, the number of inner iterations allowed per group can be increased. 

The relaxation parameters to be used are problem dependent. Therefore, the param- 
eters that will yield the fastest convergence must be determined for any given class of 
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similar problems. In general, however, the larger the number of mesh intervals and 
the less converged the fluxes, the closer the inner iteration parameter OMEGA should be 
to 1 . The size of the problem to which the outer iteration parameter OMEGAP is applied 
is also related to the number of energy groups. Usually OMEGAP should be closer to 1 
than OMEGA. 

The program does have test procedures so that some convergence must be attained 
before overrelaxation will be applied. Also, some degree of convergence must be main- 
tained to continue the application of the relaxation parameter. However, too large a 
value of the parameter will, for those iterations in which it is applied, override the con- 
vergence achieved during the iterations in which it was not applied. 

For negative KACCEL, a new inner iteration overrelaxation factor is computed by 
the method of Wachspress (ref. 12) by the program after further convergence of the group 
fluxes is attained, and this parameter is then used for the rest of the iterations in the 
group. The process is repeated during each outer iteration. 

The total number of inner iterations ITMI and time required TIMEX is roughly pro- 
portional to the average number of neutron collisions per neutron lifetime (ref. 2). Con- 
vergence will be slower in regions with longer lifetimes, and problems containing such 
regions, such as problems with large voids or reflectors, may be expected to require 
more inner iterations to obtain converged fluxes. These regions may have relatively 
small effect on the eigenvalue, however. If this is the case, the problem will not need to 
be restarted if only the eigenvalue is desired. 

[12] An input zone is a region with constant mesh width and only one material. If 
either the mesh width or the material changes, another input zone is required. An output 
zone is a region with only one value of the output identification number. The output zone 
is not dependent on mesh width, and different materials can have the same identification 
number if they are to be combined in the output. 

[13] For Pq cross sections, the flux -weighted average cross sections 2 g are ob- 
tained so that 



S gik*gik V ik 
= iik 

Svt 

i,k 


for those mesh intervals i,k over which the average is to be obtained. For the scatter- 
ing array, the average cross section 2 g ,_ g is obtained by replacing S gik by 
^g'*g.i,k ^gik ^g’^k’ The average scattering removal cross section is ob- 
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tained in the same way as 2 g , and the within -group -scattering cross section is obtained 
by neutron balance so that 


2 


g-*g 





The cross section 2„ _ is obtained so that 2® = 2^ + 2„ „ and will be incorrect for 

g-g g g g~g 

computing the scattering source if n — 2n scattering is present. 

Collapsed group cross sections, except for the scattering array, are obtained in the 
same manner as flux -weighted cross sections with the summations over the groups to be 
collapsed rather than the mesh intervals. The scattering array is obtained so that the 
in -scattering source to the collapsed group is the sum of the sources to the groups to be 
collapsed from the other groups. The collapsed-group-scattering removal is computed 
by summing the appropriate terms from the collapsed -group -scattering array and will be 
incorrect if n — 2n scattering is present. The within -collapsed -group scattering is 
computed similar to that for flux -weighted cross sections by neutron balance. If n — 2n 
scattering is present the within -collapsed -group scattering will be incorrect both because 
the scattering removal is incorrect and because of the balance technique. 

[14] The number of directions ND for which direction cosines and weights are sup- 
plied in the input depends on the geometry of the problem and the order n (NSN) of the 
quadrature. For two-dimensional problems (NZ > 0) or for one -dimensional cylindrical 
geometry, ND = NSN (NSN + 4)/4. For one -dimensional slabs and spheres, ND = NSN + 1. 
Note here that one -dimensional slabs can be treated as two dimensional as far as quadra- 
ture is concerned by setting NZ = 1 . 

For two-dimensional problems, the ND values of the weights (W) should add to 1. 

The actual number of directions used by the program is twice that of ND and includes the 
downward directions as well as the upward directions included in the input. The weights 
are halved by the program to account for the extra directions. 

Tables of values for two possible methods of quadrature are listed in appendix B. 
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APPENDIX B 

DIRECTION QUADRATURE TABLES 


The projection invarient sets are given in the following tables, where DR is the 
cosine in the R -direction, W is the weighting factor, and DZ is the cosine in the Z- 
direction 


PROJECTION INVARIANT SET A (REF. 2) 


Quadrature 

One -dimensional set 

Two-dimensional set 


DR 

w 

DR 

DZ 

w 

S 2 

- 1.0 

0 

-0.81649660 

0.57735027 

0 


-.57735027 

.5 

-.57735027 

.57735027 

.5 


.57735027 

.5 

.57735027 

.57735027 

.5 

S 4 

- 1.0 

0 

-0.47140452 

0.88191710 

0 


-.88191710 

.1666667 

-.33333333 

.88191710 

.1666667 


-.33333333 

.3333333 

.33333333 

.88191710 

.1666667 


.33333333 

.3333333 

-.94280904 

.33333333 

0 


.88191710 

.1666667 

-.88191710 

.33333333 

.1666667 




-.33333333 

.33333333 

.1666667 




.33333333 

.33333333 

.1666667 




.88191710 

.33333333 

.1666667 

S 6 

- 1.0 

0 

-0.36514837 

0.93094934 

0 

-.93094934 

.0916667 

-.25819889 

.93094934 

.09166667 


-.68313005 

.150 

.25819889 

.93094934 

.09166667 


-.25819889 

.2583333 

-.73029674 

.68313005 

0 


.25819889 

.2583333 

-.68313005 

.68313005 

.075 


.68313005 

.150 

-.25819889 

.68313005 

.075 


.93094934 

.0916667 

.25819889 

.68313005 

.075 




.68313005 

.68313005 

.075 




-.96609178 

.25819889 

0 




-.93094934 

.25819889 

.09166667 




-.68313005 

.25819889 

.075 




-.25819889 

.25819889 

.09166667 




.25819889 

.25819889 

.09166667 




.68313005 

.25819889 

.075 




.93094934 

.25819889 

.09166667 
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Quadrature 

One -dimensional set 

Two-dimensional set 


DR 

W 

DR 

DZ 

W 

S 8 

-1.0 

0 

-0.30860672 

0.95118972 

0 

-.95118972 

.06349070 

-.21821790 

.95118972 

.06349070 


-.78679579 

.09138352 

.21821790 

.95118972 

. 08349070 


-.57735027 

. 12676087 

-.61721341 

.78679579 

0 


-.21821790 

.21836491 

57735027 

.78679579 

.04569176 


.21821790 

.21836491 

-.21821790 

. 78679579 

.04569176 


. 57735027 

. 12676087 

.21821790 

.78679579 

.04569176 


.78679579 

.09138352 

. 57735027 

.78679579 

.04569176 


.95118972 

.06349070 

-.81649658 

. 57735027 

0 




-.78679579 

.57735027 

.04569176 




-. 57735027 

. 57735027 

.03537735 




-.21821790 

.57735027 

.04569176 




.21821790 

. 57735027 

.04569176 




. 57735027 

. 57735027 

.03537735 




.78679579 

. 57735027 

.04569176 




-.97590007 

.21821790 

0 




-.95118972 

.21821790 

.06349070 




78679579 

.21821790 

.04569176 




-.57735027 

.21821790 

.04569176 




-.21821790 

.21821790 

.06349070 




.21821790 

.21821790 

.06349070 




. 57735027 

.21821790 

.04569176 




. 78679579 

.21821790 

.04569176 




.95118972 

.21821790 

.06349070 


PROJECTION INVARIANT SET B (REF. 2) 


Quadrature 

One -dimensional set 

Two-dimensional set 


DR 

W 

DR 

DZ 

W 

S 2 

-1.0 

0 

-0.81649660 

0.57735027 

0 


-. 57735027 

.5 

-.57735027 

. 57735027 

.5 


. 57735027 

.5 

.57735027 

. 57735027 

.5 

S 4 

-1.0 

0 

-0.71007688 

0.70412415 

0 


-.70412415 

.33333333 

-.70412415 

.70412415 

. 16666667 


-.09175171 

. 16666667 

-.09175171 

. 70412415 

. 16666667 


.09175171 

. 16666667 

.09175171 

.70412415 

. 16666667 


.70412415 

.33333333 

.70412415 

.70412415 

. 16666667 




-.99578192 

.09175171 

0 




-.70412415 

.09175171 

. 16666667 




.70412415 

.09175171 

. 16666667 





APPENDIX C 


OUTLINE OF PROGRAM DECKS 

The program decks required by the TDSN program as used on the Lewis Monitor 
System, are listed. The output of the sample problem in appendix E also gives a listing 
of the subroutines used by TDSN as well as subroutines provided by the Lewis Monitor 
System. 


Deck name 

Language 

Purpose 

TDSN 

FORTRAN IV 

To call the overlays 

TIME1 

MAP 

To read the storage cell clock. Time re- 
turned is in clock pulses, which are 1/3600 
of a minute each. This subroutine is system 
oriented. Other users will need to change 
the program to call their own subroutine or 
write a dummy subroutine to return a zero 
when called. 

The first overlay is 

as follows: 


INPUT 

FORTRAN IV 

To read in the nonsubscripted input and cal- 
culate the storage locations for the sub- 
scripted input 

READSV 

FORTRAN IV 

To read in the subscripted input variables 

XSTDSN 

FORTRAN IV 

To obtain S n format cross sections from 
diffusion format input 

SETUP 

FORTRAN IV 

To compute various quantities required for 
every iteration 

BCREAD 

MAP, Version 12 

To read absolute binary cards (maximum of 
22 words per card) from a previous problem 
dump 

.READ5 

MAP, Version 12 

Used by BCREAD 


The second overlay is as follows: 


OUTER FORTRAN IV Contains the outer (power) iteration loop and 

convergence tests. 
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Deck name 


Language 
ORSCAL FORTRAN IV 

FISION FORTRAN IV 


FIXED FORTRAN IV 

INNER FORTRAN IV 

SORAXS FORTRAN IV 


FLUX FORTRAN IV 


The third overlay is as follows: 


DUMPBC 

BCDUMP 

. PCH. 
OUTPUT 


FORTRAN IV 

MAP, Version 12 

MAP, Version 12 
FORTRAN IV 


The fourth overlay is as follows: 


TABLES 

FORTRAN IV 

IDACAV 

FORTRAN IV 

TABLE 

FORTRAN IV 

SUM 

FORTRAN IV 


Purpose 

To compute the correction factor to be ap- 
plied to the currents and angular boundary 
fluxes if overrelaxation has been applied 
To compute the production neutron density 
and the new X and to renormalize to cor- 
rect the power level after each outer itera- 
tion 

To compute that portion of the source that 
remains fixed within the inner iterations 
Contains the inner iteration loop and conver- . 
gence tests 

To look up the within -group -scattering cross 
section and the total collision -loss cross 
section 

To compute the angular fluxes and the new 
scalar flux and current 


To give restart and flux and current binary 
card dumps 

To punch data in absolute binary (maximum 
of 22 words per card) 

Used by BCDUMP 

To give the output after the final outer itera- 
tion consisting of integrated quantities and 
the production rate, fluxes, and currents 


To set up to give the activity and averaging 
tables 

To read in output identification maps to be 
used by TABLES 

To call subroutines required and to list the 
results for the tables requested 
To compute sums of activities and fluxes 
over the output regions requested 
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Deck name 


Language 


Purpose 


AVERAG FORTRAN IV 

COLAPS FORTRAN IV 

The fifth overlay is as follows: 
EDIT FORTRAN IV 


To compute flux -weighted average cross sec- 
tions 

To compute flux -weighted collapsed -group 
cross sections 


To compute activities, flux integrals, and 
average activities for a specified cross sec- 
tion and over specified groups and regions 


Also, it should be noted that the Lewis Monitor System has the following off-line 
printer carriage control characters to be included as the first character in a format 
statement: 


J Single space before printing rest of line. 

K Double space before printing rest of line. 

L Triple space before printing rest of line. 

+ Space suppress. 

$ Punch the line instead of print. 

* Print and punch this line. 

For the first four control characters, the character must be counted as one of those 
being printed, but for the last two, the format is given as if the control characters were 
not a part of the format statement. The last control character is actually * followed by 
a blank to make up the complete control symbol. If these characters are not available in 
the operating system to be used, then other FORTRAN IV statements must be included in 
the program, particularly the PUNCH statement must be included if punched output is de- 
sired. 
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APPENDIX D 

LISTING OF PROGRAM DECKS 

IBETC TDSN DECK 

PROGRAM TDSN IS A TWO DIMENSIONAL S(N> TRANSPORT CODE. 


THE COMMON STATEMENTS 
COMMON X 


COMMON 

/CALL1/ 

KCHAIN, 

CEND. 

<EFN 


COMMON 

/CALL2 / 

KBCRED * 




1 

KREG, 

KALC , 

KGEO, 

KBBC, 

KTBC . 

KLBC • 

2 

KRBC » 



NSN . 

NG. 

NZ, 

3 

NR, 

NTYPS, 

NMAT . 

LBUCK, 


KCTYP, 

4 

KSISO. 

kgst. 

KCTR, 

KCGG. 

KDREAD , 

kfluxi , 

5 



ITMIMX, 

ITMIGM* 

NZONER ♦ 

NZONEZ, 

6 

KACCEL, 

KALC1 , 

NFN. 

N2N, 


ITMPRT, 

7 

KBCDUP , 

KACAV, 

KGAVE . 

KNIP. 

KEDIT. 


8 



GLAM, 

EIGEN. 

EPS, 

XNF , 

9 

RYE, 

UMAX, 

CALC1, 


OMEGA , 

OMEGAP 

COMMON 

/CALL3/ 





1 



HZ. 

HY. 

BF, 


2 





ICCA. 

KCF , 

3 

KONV , 

KFIN5H, 

KASOR . 

KUPS. 



4 

NBF » 

ND, 

NGP1 . 

NZP1. 

NRP1 , 


5 

HI J, 

NTYNG, 

NDNZ * 

NDNR , 

NDN I J , 

NDNZNG, 

6 

NXNZS, 

NAR, 

NC. 

NI JG. 

NBUCK , 


7 

I TMA* 

ITMI * 

ITMIST, 

ITMI GX * 

ITD, 


8 



NEGSOR. 


LZSAV, 


9 

TIMEX, 

timez. 



SDGFG1 , 

SCALUP 

COMMON 

/CALL-4/ 

EPG, 

EPGX, 

FPGM . 

EPGMP , 

1 



OMEGAS. 

OMEGPS. 



2 


EXTRA1, 

EXTRA2. 

EXTRA3. 

EXTRA4, 

EXTRA5 , 

3 


KXTRA1, 

KXTRA2. 

KXTRA3. 

XXTRA4 , 

KXTRA5 

COMMON 

/COUTER/ 

KDR * 

<DZ. 

<MR , 

KW* 

1 

KNI , 

KNO, 


K180, 

KWH I TE , 

KNOR, 

2 

KNORUP, 

KNZRf 

KNR * 

ICJRR, 

KJZR, 


3 


KNZ 





COMMON 

/CINPT1/ 

LKI . 

LICE. 

LFG, 

LKF, 

1 

LKASf 

LAG. 

LFNG. 

LSG, 

LASG , 

LBNLG , 

2 

LSCGt 

LSDG. 

LSI NG* 

LXNG * 

1 — IRG » 

LJZG, 

3 

LXNB * 

LHNLG, 

LVNLG, 

lxnlg. 

LBUC. 

LMXVAR, 

4 

LAR, 

LAZ. 

LR, 

LRM, 

LR A • 

LRAV, 

5 

LCT , 

LCGG . 

LCGGA, 

LSI SO , 

LST, 

LARSO, 

6 

LAZSO, 

LARST, 

LAZST, 

LCUPS. 

LESIJM, 

LDC, 

7 

LNM, 

LTVLK, 

LDELZ. 

LZ, 

LDR, 

LDZ, 

8 

LMR , 

LW. 

LN I * 

LNO , 

LN2N 


COMMON 

/CINPT2/ 

LMA, 

LV, 

LF, 

LNN , 

1 

LNA , 

LJRN, 

LJZN. 

LJRA , 

LJZA, 

LJRR, 

2 

LJZR, 

L18 0 * 

LNOR. 

LNR. 

LNORUP. 

LNZR, 

3 

LNZ , 

LNQSUP, 

LNZ5* 

LNOS * 

LN, 


4 

L JR , 

LJZ. 


LC. 

LNBUC, 


3 

lwhite* 

LBCDUP, 



LM ID » 

LNM 1 , 

6 

LNMR * 

LRMI . 

LDZ1 . 

LC1 , 



7 

LST G * 





LNORM, 

8 



LNMRA, 

LNMZA, 

LI DM, 

LIDMAP, 

9 

LIDGP 






COMMON 

/CINPT3/ 



LAST1, 

LAST2 , 



n n r> on nnno n n n non nnn 


1 LAST3 * LAST4, LAST 


THE DIMENSION STATEMENTS 
DIMENSION X ( 1 7500 ) 


1000 KCHA I N= 1 

1100 GO TO (1105,1205*1305,1405,1500). KCHA I N 

1105 CALL INPUT 
GO TO 1100 

1205 CALL OUTER < X < LK I ) »X < LKE > » X ( LMA ) ,X ( LC ) , X ( LDR ) , 

1 X ( LFG ) »X ( LF ) » X(LNOS) »X(LN0SUP ) ,X (LNZS) ,X(LN) ,XCLJR ) , 

2 X(LJZ), X ( LV ) , X ( LAR ) ,X ( LAZ ) ,X(LDELZ) , X ( LKF ) , X ( LKAS ) , 

3 X ( LAG ) ,X(LFNG) »X ( LSG ) ,X(LASG) , X ( LSCG ) , X ( LSDG ) , X ( LS I NG ) ,X(LXNG) , 

4 XILXNB ) ,X< LHNLG) ,X(LVNLG> *X(LXNLG) , X ( LCT ) , X ( LCGG ) , X ( LCGGA ) , 

5 X(LTVLK) ,X(LSISO) ,X(LST) ,X(LARSO) ,X (LAZ SO) ,X ( LARST ) ,X(LAZST> , 

6 X(LDC), X(LBNLG), X(LCUPS) ,X(LN2N) , X(LNM), X(LNN), 

7 X(LNA), X(LJRN) .X(LJZN) .XtLJRA) ,X(LJZA) , 

8 X ( L180 ) , X ( LBUC ) »X ( LNBU.C ) ,X ( LMXVAR ) , 

9 X(LESIJM) ) 

BCDUMP OF THE PROBLEM. 

1250 CALL DUMP3C 
GO TO 1100 

1305 CALL OUTPUT ( X ( LMA ) , X ( LFG ) , X ( LF ) , 

1 X(LN), X(LJR),X(LJZ), X(LV), 

2 X ( LKF ) , X ( LKAS ) , X ( LAG ), X ( LFNG >, X ( LSG ), X ( LASG ), X ( LSCG ) . 

3 X(LSDG) ,X(LSING) , X ( LXNG ) ,X(LJRG> ,X(LJZG) ,X ( LXNB ) ,X( LHNLG) , 

4 X(LVNLG) , X ( LXNLG ) ,X( LBNLG ) , X(LSTG), 

5 X(LNORM), X(LBUC). 

6 X(LMXVAR) ,X(LESIJM) ) 

GO TO 1100 

1405 CALL TABLES ( X ( LMA ) , X ( LC ) , X ( LN2N ) , X(LN), X ( L JR ) , X ( L JZ ) , 

1 X ( L V ) , X(LNMRA) ,X(LNMZA) , X ( L I DM ) , X ( L I DM AP ) , X(LIDGP) ) 

1500 IF (KEDIT) 1000,1000,1505 

1505 IF (KEDIT-10) 1510,1000,1000 

1510 CALL EDIT ( X ( LMA ) *X ( LC ) *X (LN ) ,X ( LV ) ) 

GO TO lOCZ) 


END 
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SI8FTC INPUT DECK 

SUBROUTINE INPUT 


SUBROUTINE INPUT IS THE OVERLAY <OR CHAIN) SUBROUTINE OF TDSN 

THAT READS IN THE INPUT PARAMETERS, COMPUTES OTHER PARAMETERS. 
AND CALLS THE READ SV, SETUP. ANO FI SION SUBROUTINES. 


THE COMMON STATEMENTS 
COMMON X 


COMMON 

/CALL1/ 

KCHAIN. 

KENO, 

KEFN 


COMMON 

/CALL2/ 

KBCREO, 




1 

KREG, 

KALC. 

KGEO . 

KBBC. 

KTBC, 

KLBC, 

2 

KRBC, 



NSN , 

NG, 

NZ, 

3 

NR. 

NTYPS. 

NMAT • 

LBUCK, 


KCTYP, 

4 

KS I SO. 

KGST, 

KCTR. 

KCGG » 

KDREAD, 

KFLUXI 

5 



ITMIMX, 

ITMIGM, 

NZONER, 

NZONEZ 

6 

K ACCEL. 

KALC 1. 

NFN, 

N2N, 


ITMPRT 

7 

KBCDUP . 

KACAV. 

KGAVE . 

KNIP, 

KEDIT, 


B 



GLAM. 

EIGEN, 

EPS, 

XNF , 

9 

RYF. 

TIMAX. 

CALCi, 


OMEGA, 

OMEGAP 

COMMON 

/CALL3/ 





1 



HZ. 

HY, 

BF, 


2 





KCA, 

KCF, 

3 

KONV. 

KFINSH, 

KASOR. 

KUPS, 



4 

N8F, 

ND. 

NGP1 . 

NZP1, 

NRP1. 


5 

NIJ. 

NTYNG, 

NDNZ, 

NDNR. 

NDNIJ, 

NDNZNG 

6 

NXNZS. 

NAR. 

NC, 

Ni JG, 

NBUCK , 


7 

ITMAt 

ITMI . 

ITMIST. 

ITMIGX, 

ITO, 


8 



NEGSOR, 


LZSAV, 


9 

TIMEX. 

T I ME 2 « 



SDGFG1 • 

SCALUP 

COMMON 

/CALL A/ 

EPG, 

EPGX, 

EPGM, 

EPGMP. 

1 



OMEGAS, 

OMEGPS, 



2 


EXTRA1, 

EXTRA2 , 

EXTRA3, 

EXTRA4, 

EXTRAS 

3 


KXTRAI, 

KXTRA2 , 

KXTRA3, 

KXTRA4, 

KXTRA5 

COMMON 

/COUTER/ 

KDR, 

KDZ • 

KMR, 

KW, 

1 

KNI » 

KNU, 


K180, 

KWHITE, 

KNOR, 

2 

KNOROP. 

KNZR * 

KNR , 

KJRR , 

K JZR* 


3 


KNZ 





COMMON 

/CINPTl/ 

LKI , 

LKE, 

LFG, 

LKF, 

1 

LKAS , 

LAG * 

LFNG. 

LSG , 

LASG, 

LBNLG, 

2 

LSCG, 

LSDGt 

LSING. 

LXNG , 

LJRG, 

L JZG* 


L XN t» * 

LHNLG. 

LVHLG. 

LXNLG, 

LBUC, 

LMXVAR 


L AK « 

LAxt , 

LR. 

LkM , 

LRA, 

LRAV » 

b 

LLl , 

LU>1>« 

LCGGA. 

LS l SO, 

LST , 

LARSU, 

6 

LAZSU. 

LAkbJ , 

LA/ST, 

LLUPS* 

LtSI JM, 

LDC , 

7 

LNM v 

LTVLK, 

LOELZ, 

LZ. 

LOR, 

LDZ, 

b 

LMR * 

L W , 

LNI , 

LNO , 

LN2N 


COMMON 

/CINPT2/ 

LMA . 

LV, 

LF, 

LNN , 

1 

LNA. 

LJRN, 

LJZN. 

LJRA, 

LJZA, 

LJRR, 

2 

L JZR. 

L I 80, 

LNOR, 

LNR , 

LNORUP, 

LNZR* 



o u o o u 


3 

LNZ* 

LNUSUP * 

LNZS. 

LNGSt 

LN, 


4 

LJR • 

LJ Z. 


LC* 

LNBUCf 


5 

LWHITE* 

LBCDUP • 



LMI 0* 

LNMI , 

6 

LNMRt 

LftMI. 

LDZ1, 

LCi • 



7 

LSTG* 





LNORM, 

8 



LNMRAt 

LNMZA, 

L I DM* 

LIDMAP 

9 

LIDGP 






COMMON 

/CINPT3/ 



LAST1 * 

LAST2, 

1 

LAST 3* 

L A ST4* 

LAST 





COMMON 

/CSfcTUP/ 

KALCPlt 

A VF t 

PI t 

GLAMP, 


1 EXTRP 

c 

C THE DIMENSION STATEMENTS 

DIMENSION X I 17500 1 

DIMENSION TITLE! 14) 

C 

C 

C THE FORMAT STATEMENTS 

100 FORMAT ( 1H1 ) 

101 FORMAT ( 1HL ) 

102 FORMAT I INK ) 

103 FORMAT ( 1H ) 

104 FORMAT ( 1HL » 2 1HPR0GRAM STOP AT KEFN= » 1 8 ) 

105 FORMAT I 11, 1X.14A5) 

106 FORMAT (2X.14A5) 

107 FORMAT ( 1HL . 6X, 7HKBCRED=. 1 2) 

108 FORMAT I 1HL . 29HPR0GRAM SIZE EXCEEDEO. LAST=,I8,32H WITH 17500 ST 
10RAGES AVAILABLE.) 

110 FORMAT (7110) 

111 FORMAT I 7116) 

112 FORMAT (7L10.6) 

113 FORMAT ( 7E16.8) 

114 FORMAT (2E16.8.48X.2I 16) 

115 FORMAT ( 5E10.6.21 101 

120 FORMAT ( 1HL , 10X .4HKREG. 12X .4HKALC . 12X .4HKGE0. 12X ,4HKL BC, 12X , 

1 4HKRBC, 12X.4HKBBC, 12X.4HKIBC) 

121 FORMAT ( 1HL ,1 1X.3HNSN, 14X.2HNG.14X.2HNR. 14X ,2HNZ , 12X . 4HNMAT .1 IX, 

1 5HNTYPS. 13X.3HN2N) 

122 FORMAT l 1HL , 9X, 5HKC TYP, 1 IX ,5HKSI SO , 12X .4HKGST , 12X , 4HKCTR , 12X, 

1 4HKCGG.11X.5HNB0CK.11X.5HLBUCK) 

123 FORMAT I 1HL . 8X , 6HI TMI MX, 10X, 6HI TMI GM .10X ,6HNZ ONER. 10X .6HNZ0NEZ , 
l 10X, 6HKDREAD, 10X, 6HKFLUXI ,11 X. 5HKALC1 ) 

124 FORMAT < 1HL , 8X , 6H I TMPRT, 1 OX , 6HKBCDUP ,1 1 X .5HKAC AV , 1 1 X .5HKGAV E, 

1 12X.4HKNIP.11X.5HKLUIT) 

125 FORMAT ( 1 HL . 1 OX . 4HGL AM . 1 1 X , 5HE IGEN , 1 3X . 3HEPS . I 3 X ,3HXNF , 13X , 3HRYF , 

1 11X.5HTIMAX.HX, 5HCALC1 ) 

126 FORMAT ( 1HL . 12 X , 2HHZ , 14X , 2HH Y , 14X ,2HBF ) 

127 FORMAT I 1HL . 9X , 5H0MEGA , 10 X , 6H0MEGAP , 58X . 6HK ACC EL , 1 2X , 4HK0PS ) 

131 FORMAT ( 1HL , 10X , 4HL A ST .11X.5HLAST1 , 1 1 X .5HLAST 2 , l IX , 5HL AST3 , 1 1 X , 

1 5HLAST4) 


READ INPUT PARAMETERS. 


1000 WRITE (6, 100) 
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1005 READ (5,105) NTITLE, (TITLEU), 1=1,14) 


WRITE (6,106) (TlTLE(l), 1=1,14) 

IF (NTITLE) 1005,1005,1010 
1010 READ (5,110) KBCRED 
WRITE (6,107) KBCRED 
IF (KBCRED) 1020, 1020.1015 

1015 I TEMP=KbCRED 

CALL BCREAD ( KR EC, LAST ) 

KBCR£D= I TEMP 

CALL BCREAD (X ( 1) . X( LBCOUP) ) 

IF (KBCRED-2) 1100,1016,1016 

1016 READ (5,110) ITMIMX, I THIGH 

READ (5,115) EPS, UMAX, OMEGA, OMEGAP, TEMP, KACCEL.KUPS 
IF ( KBCRED-3) 1660,1019,1060 
1019 READ (5,110) I TMPRT ,KBCOUP,KACAV,KGAVE,KNiP,KEOIT 


GO TO 1060 
1020 READ ( 5, lid 


1 

2 

3 


KR£G,KALC , KGEO, KL BC , KRBC , KBBC, KTBC, 

NSN, NG, NR , NZ , NMAT ,NTYPS,N2N, 

KC TYP. KSI SO, KGST , KCTR , KCGG, NBUCK ,LBUCK, 

ITMIMX, 1 TMIGM,NZ0NER,NZ0NEZ ,KOR£ AD, KFLUX I ,KALCL 


READ (5,112) GLAM, EIGEN. EPS. XNF,R YF ,T I MAX.CALC1 
HEAD (5,115) OMEGA, OMEGAP, TEMP * TEMP ,TEMP , KACCEL.KUPS 
READ (5,110) I TMPRT, KBCDUP ,KACAV,KGAVE ,KNIP,KEDIT 


1025 

1035 

1040 

1045 

1050 

C 

C 

1060 

1065 

1070 

1075 

1080 

1085 

C 

C 

C 

1100 


NBF= 1 

IF (NBUCK) 1025,1060,1060 
READ (5,112) HZ,HY,BF 
IF (BF-0.1E-07) 1035,1035.1040 
BF= 1*81 37994 
NBF=NR 

IF (NZ) 1060, 1060, 1045 

GO TO (1050,1060.1060). KGEO 

NBF=NBF*NZ 


IF (ITMIMX) 1065,1065,1070 
I TM IMX=4000 

IF ( I TMIGM ) 1075.1075,1080 
1 TM l GM=20 

IF ( T I MAX— 0. IE— 07 I 1085,1085.1100 
I IMAX= 1,5 

WRITE INPUT PARAMETERS. 

WRITE (6,120) 

WRITE (6,111) KREG, KALC, KGEO. KLBC , KRBC, KBBC, KTBC 
WRITE ( 6 * 121) 

WRITE (6,111) NSN, NG, NR, NZ, NMAT, NTYPS,N2N 
WRITE (6,122) 



non 


WRITE (6,111) KCTYP,KSlSO» KGS T « KC TR » KCGG , NB UC K « LBUCK 
WRITE (6,123) 

WRITE (6,111) ITMIMX,lTMlGM,NZONEH,NZONEZ,KDREAO,KFLUXI,KALCl 
WRITE (6,125) 

WRITE (6,113) GLAM, EIGEN, EPS, XNF , RYE .TIMAX.CALC1 
WRITE (6,127) 

WRITE (6,114) OMEGA, OMEGAP .KACCE L , KUPS 
WRITE (6,124) 

WRITE (6,111) ITMPRT.KBCOUP.KACAV.KGAVE ,KNI P.KEOIT 
IF t NB) — 1 ) 1125,1125,1105 

1105 WRITE (6,126) 

WRITE (6,113) HZ.HY.BF 
NBUCK=0 

TO COMPUTE OTHER PARAMETERS. 

1125 IF ( IABSIKACCEL )- 1 ) 1130,1135,1140 
1130 0MEGA=1.0 
1135 OMEGAP= 1.0 
1140 OMEGAS=UMEGA— 1.0 
CMEGPS=OMEGAP- l .0 
C 

1150 IF ( KBCKED) 1155,1155.1240 
1155 GO TO (1160,1165,1161), KGEO 
1160 IF (NZ-1) 1161,1165,1165 
116 1 NO=NSN + 1 

GO TO 1170 

1165 N0=(NSN*(NSN+4) )/4 
1170 NGP 1=NG + 1 
NRP l=NR + 1 
NONR=ND*NR 
NDNRNG=NDNR*NG 
LZSAV=0 

IF (NZ-1) 1180,1180,1175 
1175 AVF= 2. 0 

IF ( KTBC ) 1181,1181.1177 
1177 NXNZ S=NDNRNG 
LZ S AV= 1 
GO TO 1185 

1180 AVF= 1.0 
NZ= 1 

1181 NXNZ S= l 

1185 NIJ = NR<»NZ 
NZP 1=NZ + 1 
NAR=NRP 1*NZ 
NTYNG=NTYPS*NG 
NONZ=NO*NZ 
NON I J = ND*N I J 
NDNZNG=NDNZ*NG 
NC=NTYNG*NMAT 
N I J G=N 1 J *NG 

IF (NBUCK) 1189,1189,1186 

1186 N8UCK=NMAT*NG 
C 

1189 KEND=0 

K EFN= 1189 
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I TMIST=Q 
I TMA=Q 
KCa=KCTR-2 
KCF=KCTR— 1 
EPGM^O.O 
C 

C LOCATION OF VARIABLES IN INCLUSIVE X ARRAY. 

C 

1190 LK 1=1 
LKE=LK I +NGP 1 
LFG=LKE+NGP l 
LKF=LFG+NGP 1 
LKAS=LKF+NG 

IF (KS1S0I 1191. 1191.1192 

1191 L ASG=LKAS+1 
L JRG=LASG+i 
L JZG=L JRG+1 
L AG=L J ZG+ 1 
GO TO 1193 

1192 LASG=LKAS+NG 
LJRG=LASG+NG 
LJZG=LJRG+NG 
LAO=LJZG+NG 

1193 LFNG=LAG*NGP 1 
LSG=LFNG«-NG 
LSCG=L SG+NGP 1 
LSDG=LSCG+NGP 1 
LS1NG=L SDG+NGP 1 
LXNG=LS ING+NGP 1 
LXNB=LXNG+NGP 1 
LHNLG=LXNB+NGP 1 

IF INZ-1) 11186.11186.11187 

11186 LVNLG=LHNLG+1 
GO TO 11188 

11187 LVNLG=LHNLG*NGP1 

11188 LXNLG=L VNLG+NGP 1 
LBNLG=LXNLG*NGP1 

IF i NBUCK I 11189.11189.11191 

11189 IF INBF-1) 1119G. 11190. 11191 

11190 LMXVAR=L BNLG+1 
GO TO 11192 

11191 LMXVAR=LBKLG+NGP1 

11192 LES I JH=LHXVAR+NG 
LBUC=LES I JH*NG 

C 

IF ILBUCKI 1 1 194* 11193. Ill 94 

11193 L DR=LBUC + 1 
GO TO 11195 

11194 LOR=LBUC+NG 

11195 KDR= 1 
LOZ=LDR*ND 
KOZ=KDR*NO 
LMR=LOZ+ND 
KMR=KDZ+ND 
LM=LMR+NO 
KW=KMR+NO 



LN 1 =LW+ND 
KN I =K W+ND 
LNG=LN 1 +ND 
KNCJ=KN I + ND 
C 

LNOSUP=LNO+NU 

IF (NZ-1) 1194.1194,1193 

1194 LNZS=LNGSUP*1 
GO TG 1196 

1195 LNZ S=LNGSU F+NDNZNG 

1196 LNGS =L NZ S+NXNZ S 
LN=LNOS+NDNZNG 
1.JR=LN*NIJG 

IF (KSISO) 1197* 1197.1 199 

1197 L JZ =L JR+ 1 

1198 LN2N-L J Z ♦ 1 
GG TO 1201 

1199 L JZ=L JR+N I JG 

IF (NZ-1) 1198,1198.1200 

1200 LN2N-LJZ+NIJG 

1201 LCUPS=LN2N+NMAT*NG 

IF ( ( KCTR+1 KCGG ) 11198,11197,11197 
1119? KUPS=0 

LNBUC=l_CUPS+l 
GG TO 11199 

11198 LNBUC=LCUP5+NMAT*NG 
C 

11199 IF (NBUCK) 11200,11200,11201 

11200 LAR=LNBUC+1 
GU TO 11202 

11201 L AR=LNBUC+N8UCK 

11202 LAZ=LAR+NKP1 
LR = L AZ +NR 
LRM = LR +NRP 1 
LRA=LRM+ 1 
LRAV=L RA+NRP 1 
t DELZ=t RAV+NR 
l_Z=LDEl_Z+NZ 

C 

LMA=LZ+NZP 1 
LV=LMA+N I J 
LF=L V+N I J 
LC=L F+N I J 
L BCOUP=L C +NC— 1 
C 

c 

c 

L CT=LC+NC 

LCGG=LCT +NR 

LSISO=LCGG+NR 

LST =LSI SO+N I J 

LDC=LST +NK 

LNM=LOC+NR 

LTVLK=LNM+NK 

l_CGGA=L TVLK+N6F 

IF (KSISO) 1202. 1202,1204 


\ 
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1202 LARSO=LCGGA+l 
LARST=LARSO+l 
LAZSU=LARST + 1 

1203 EAZST=LaZSU + 1 
L JR A=L AZST + 1 
GO TO 1206 

1204 LARSO=LCGGA+NR 
LARST=l_ARSO+M J 
LAZi»0=L ARST +NR 

IF ( NZ— 1 ) 1203. 1203,1205 

1205 EAZST=LAZSG+MJ 
L JRA=LAZST+NR 

C 

1206 IF IKSISQ) 1207.1207.1209 

1207 LJRN=L JRA+1 
LJZN=LJRN+1 

1208 LJZA=LJZN+1 
LNN=LjZA+1 
GO TO 1211 

1209 L JRN=L JRA+N I J 
LJZN=LJRN+NIJ 

IF (NZ-l) 1208. 1208. 1210 

1210 LJZA=LJZN+NIJ 
LNN=L JZ A+N l J 

1211 LNA=LNN*NI J 
C 

L180=LNA+N1J 
K 180=1 

IF IKBBC-4I 11211. 11212. 11211 

11211 LWHI T £=L 180+1 
KWH IT E=K 180+1 
GO TO 11213 

11212 TEMP=NSN 
TtMP=T£MP/2.0 
TEMP=T£MP+0* 1 
ITtMP=TEMP 
ITEMP=NR*1TEMP 
LWHITE=L 180+ l TEMP 
KWH IT E=K 180+ 1 TEMP 

11213 IF IKRBC-3) 12 12. 12 1 3. 12 12 

1212 LNURUP=LWHITE+1 
KN0RUP=KWHITE*1 
GO TO 1214 

1213 EN0RUP=LWHl TE+NZ 
KNORUP-KWHITE+NZ 

1214 IF ( KRBC > 1215.1215. 1220 

1215 IF < KT6C ) 1216.1216.1220 

1216 LNZR=LNGRUP+i 
KNZR=KNURUP+1 
LN0R=LNZR+1 
KN0R=KNZR+1 
LNR=LN0R+1 
KNR=KNGR+1 
LJRR=LNR+1 
KJRR=KNR+1 

1217 LJZR=LJRR+1 



on on no 


K JZR=K JRR+ 1 

1218 LNZ=LJZR+1 
KNZ=KJZR+1 

IF ( NZ— 1 ) 1219* 12 19, 1228 

1219 L AST 2=LNZ+ 1 
GO TO 1230 

1220 IF (NZ-i) 1221* 1221* 1223 

1221 LNZR=LNORUP + 1 
KNZR=KNORUP+l 

1222 LNOR=LNZR+ 1 
KNQR=KNZR+ 1 
GO TO 122b 

1223 LNZR—LNQROP+NDNZ 
KNZR=KNORUP+NDNZ 

IF (LZSAV) 1222*1222.1224 

1224 LNOR=LNZR+NDNR 
KNOR^KNZR+NDNR 

1225 LNR=LNOR+NDNZ 
KNR=KNOR+NDNZ 
LJRR=LNR+NI J 
KJRR=KNR+NIJ 

IF CKSISO) 1217, 1217* 1226 

1226 L JZR=L JRR+N I J 
KJZR=KJRR+NIJ 

IF IN Z-i) 1218. 1218* 1227 

1227 LNZ=L J ZR+N I J 
KNZ=KJZR+NIJ 

1228 LAST 2=LNZ+NDNR 


1230 NMXZON=NZUNER 

IF (NZQNEZ-NMXZGN) 1232, 1 232 , 1 23 l 

1231 NMXZON=NZGNEZ 

1232 LMI0=LCT 
LNMI=LM1D+NMXZ0N 
LNRR=LNM I +NMXZQN 

IF (KFLUXI) 1235, 1235,1233 

1233 IF (NMXZON-5) 1 234 * 1235, 123 5 

1234 NMXZUN=5 

1235 LKMI=LNMR+NHXZON 
LDZ1=LRMI*NMXZ0N 
LCl-LDZl+(NSN/2 ) + 1 
LAST 1=LC 1 +NG*N T YP S 


1237 LST G=L ARSO 

LNGRM^L ST G +NGP 1 
LAST3=LNGRM+N I J 


1240 LNMKA=LCT 

IF (KACAV) 1244,1241, 1244 

1241 IF (KGAVE) 1242 , 12*2 , 1244 

1242 LNMZ A=LNMRA+ 1 
L I DM=LNMZA+ 1 

L I DMAP=L l DM + 1 



L I DGP=L IDMAP+ i 

1243 LAST4=L IDGP+i 
GO TO 1250 

1244 LNM/A=LNMRA+50 
LIUM=LNHZA+30 
LIDMAP=LlDM+50 

L I DGP=L I UMAP+N X J 
IF (KGAVE) 1243,1243.1245 

1245 L AST4=L I UGP +NG 
C 

C 

1250 LAST=LAST 1 

IF ( LAST-LAST2) 125 1 , 1252 . 12 52 

1251 L AST=LAST2 

1252 IF UAST-LAST3) 1253. 1254, 1254 

1253 LAST=L AST3 

1254 IF (LAST-LAST4) 12 55 , 1260, 1260 

1255 L AST=L AST 4 

1260 WRITE 16,131) 

WRITE (6,111) LASTfLASTl ,LAST2,LAST3 , LA ST4 
IF (LAST-17500) 127 5, 1275, 1261 

1261 WRITE (6,106) LAST 
KENO= 1 
KEFN=126i 

GO TO 1450 
C 

c 

c 

1275 CALL TIMEKTIHEX) 

KALCP1=KALC + 1 
C 

C READ INPUT SUBSCRIPTED VARIABLES. 

C 

1300 CALL REAOSV ( 

1 XILKi ) * X1LMA ) , X(LC ) , X ( LOR) . X (LDZ) , X 1 LW) , X( LNOS ) ,X(LNOSUPI, 

2 X(LNZS) , X< LN ), X(LJR) ,X(LJ2) .XCLBUC) ,X(LNBUC), X ( LCUPS ) ,X( LN2NI • 

3 X { LM I D ) , X ( LNMI ) . X( LNMR )»X(LRMI) » X ( LR ) , X (LZ ) , X(LCl) ) 

IF (KENDI 1350.1350,1305 

1305 WRITE (6.104) KEEN 
KEEN- 1 305 
GO TO 145C 
C 

C SETUP QUANTITIES NEEDED FOR EVERY ITERATION. 

C 

1350 CALL SETUP ( X(LKI), X(LKE), X(LMA), 

1 X ( L V ) • X ( LAR ) , X ( LAZ ) .X(LDELZ) ,X(LDRJ ,X(LDZ> ,X(LMR) ,X(LW), 

2 X(LR),X(LZ),X(LRM),X(LRA) , X(LRAV) , X(LDZl) ) 

IF (KEND) 1360,1360,1355 

1355 WRITE (6,104) KEEN 
KEFN= 1355 
GO TO 1450 

1360 IF (NZ-1) 1400,1400,1365 

1365 LZP=LZ+NZ 

IF < HZ— 0 • IE— 07 ) 1366,1366.1400 

1366 IF ( KBBC ) 1370,1370.1375 
1370 HZ=X(LZP) 

GO TO 140C 
1375 HZ=2.0*X(LZP) 

C 

C 

C 

1400 KCHA IN=2 
RETURN 
C 

C IF KENC= 1 

C 

1450 WRITE (6.104) KEEN 
KCHA IN= 1 
RETURN 
C 

END 
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I 


$1 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


bfTC READSV DECK 

SUbRUUT 1NE READSV I XKi* MA , C, DR* DZ . 

1 xN* X J R * x JZ * 6UCLK, dUCKG, CUPS* 

2 M1D,NRI *NMR, kMI *R , Z*C1 ) 


C 

c 


w, X NOS « XNOSUP, XNZS * 
CN2N, 


SUbRUUT 1 N £ Rt AD SV OF 
INPUT SUb SCR I P TED 


SUBROUTINt 

VARIABLES. 


INPUT OF TDSN IS TO READ THE 


THE COMMON 

STATEMENTS 

COMMON 

/CALL 1/ 

COMMON 

/CALL 2/ 

KRfcG, 

KALC. 

KRdC. 


NR* 

NTYPS* 

K S I SO * 

KGST* 

KACCEL * 

KALC1, 

KbCDUP . 

KACAV* 

\ 

) RYF, 

T IMAX* 

CCMMON 

/CAL L 3/ 


KUNV . 
NBF « 

N 1 J * 
NXNZS. 
ITMA. 

IIMEX, 
COMMON 


KF INSH * 
ND, 

NT YNG « 
NAR* 

1 TMI , 

T1MEZ* 

/CALL4/ 

EXTRA 1* 
KXTKAl, 


KCHAIN. 

KEND* 

KEF N 


KBCRED* 




KGEO • 

KdBC, 

KTBC* 

KLBC* 


NSN * 

NG, 

NZ, 

NMA T * 

LBUCK, 


KCTYP, 

KCTR, 

KCGG * 

KOREAD, 

KFLUXI* 

ITMiMX* 

1 TMI G M * 

NZONER* 

NZONEZ* 

NFN • 

N2N, 


ITMPRT* 

KGAVfc * 

KNIP, 

KEDIT* 


GLAM* 

EIGEN* 

EPS. 

X NF , 

CALC 1 * 


OMEGA, 

UMEGAP 

HZ* 

HY* 

BF , 




KCA* 

KCF * 

KASOR* 

KUPS. 



NGP I * 

NZ PI . 

NRPl * 


NDNZ • 

NDNR * 

NDNI J, 

NDNZ NG * 

NC * 

N I JG* 

NBUCK, 


I TMIST* 

I TMI GX * 

I TO * 


NEGSOR* 


LZSAV, 




SDGFGl* 

SCALUP 

EPG • 

EPGX , 

E PGM, 

EPGMP * 

OMEGAS* 

OMEGPS* 



EXTKA2 . 

EXTRA3* 

E XT RA4 * 

EXTRAS, 

KXTRA2 * 

KXTRA3 * 

KXTRA4 , 

KXTRA5 


ThE DIMENSION STATEMENTS 


DIMENS ION 

XKI ( I) * 

MAIL), 

cm • 

I 

DR ( 1 ) • 

DZIU * 

win 

DIMLNS1UN 

XNUSI 1 ) . 

xnosup m * 

XNZS ( I ) 

1 

XN ( I ) , 

X JR ( I ) , 

XJZU ) , 

2 

BUCLKI 1) , 

BUCKGdl , 

CUPSi 1) 

3 

CN2N( i) 



DIMENSION 

MIDI II* 

NMI (1) , 

NMR ( 1 ) , 

1 

RMK U . 

R ( 1 ) * 

zm 

DIMENSION 

cim 




THE FORMAT STATEMENTS 


105 

FORMAT 

I IF ) 

no 

FORMAT 

( 7110) 

112 

FORMAT 

( 7E10.6) 
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i 


non on 


( 7E16.8) 

( I 5. El Q-6t 15) 

( I 16, £16.8* i 16) 

( 40131 

( I 5, E 10-6. I5.E10.6.1 5, E 10.6, 15 ,E 10. 6, 15 ,E 10.6) 

( IHL 1 35HT0Q MANY VALUES FOR FLUX XN READ IN ) 

<IHL.2X,45H NMIII) RMI(I) MIDUI ) 

( IHL » 56HTHE FIRST DIRECTION MESH CELL BOUNDARY POSITIONS <R 

1 IHL * 57HTHE SECOND DIRECTION MESH CELL BOUNDARY POSITIONS ( 

1Z(NZ) ) ) 

123 FORMAT (1HL.28HTHE MATERIAL MAP (MAINZ. NR) ) I 

124 FORMAT ( IHL . 30H7 HE FISSION SPECTRUM (XK1 (NGD ) 

125 FORMAT (1HL.37HTHE CROSS SECTIONS (C INMAT.NG.NTYPS) ) ) 

130 FORMAT (6F12.7) 

131 FORMAT ( IHL « 70HTHE MATERIAL INDEPENDENT EFFECTIVE BUCKLING CROSS S 
1ECTIONS (BUCLKING))) 

132 FORMAT ( IHL * 73HTHE MATERIAL DEPENDENT EFFECTIVE BUCKLING CROSS SEC 
i T IONS ( BUCKGINMAT *NG) ) ) 

134 FORMAT (IHL. 57HIHE OUT SCATTERING REMOVAL CROSS SECTIONS (CN2NINMA 
IT. NG ) ) ) 

135 FORMAT (6X.2hN=,I5) 

THE INTEGER FUNCTIONS 

INDEX (LENGTH, INDE XO . I NDEXL I =L£NGTH* (I NDEXO- 1 ) + INDE XL 


113 FORMAT 

114 FORMAT 

115 FORMAT 

116 FORMAT 

118 FORMAT 

119 FORMAT 

120 FORMAT 

12 1 FORMAT 
UNR))) 

122 FORMAT 


10U0 IF ( KBCRED) 1001.1001,1040 
1001 WRITE (6,120) 

DO 1005 1“ 1 .NZONER 
READ (5,114) NMR( 1 ) ,RMI ll).MID(I) 
1005 WRITE (6,115) NMRm.RMim.MIDIIl 
C 

1010 I* l 
1 1- 1 

R( I 1 )=0.0 
DELR=RMI( 1) 

GO TO 1020 

1015 DELR-RM HI 1— KM 1(1—1) 

1020 VM I =NMR( I ) 

OELK-DELR/ VM I 
12=0 

1025 12=12+1 

IF ( 1 2— NMR ( I ) ) 1030,1030,1035 
1030 I iM i= I i 
l 1=11+1 

Rl ll)=R( I1M1) +DELR 
HA( I 1M1 )=M ID( I ) 

GO TO 1025 
1035 1=1+1 

IF (I-NZONER) 1015, L015, 1040 
1040 WRITE (6,121) 

WRITE (6,113) ( R( I ) , I=1,NRP1) 

C 

1050 IF (NZ-1) 1180,1180.1055 
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1055 IF ( KBCKEL) ) 1060, 1060,1140 
1060 IF (NZONEZ-i) 1065,1065,1100 
1065 I1=NR 

DO 1070 J=2,NZ 
DO 1070 1=1, NR 
I 1=11+1 

1070 MA( I 1 ) = MA ( I ) 


1100 WRITE 16,120) 

DO 1105 J= 1 , NZONEZ 

READ 15,114) NMI( J).RMI(J) 

1105 WRITE (6,115) NMI(J),RMI(JI 

1110 J =1 
11=1 

Z1 I 1 ) = 0. 0 
DELR=RMH J) 

GO TO 1120 

1115 OELR=RM I ( J )— RM 1 C J — 1 ) 

1120 VM I =NM 1 1 J ) 

OELK=DELR/VMI 

12=0 

1125 12=12+1 

IF (I2-NMI(J)> 1130,1130.1135 
1130 I 1 M 1= I 1 
11 = 11+1 

Z( 1 1 )=Zi I 1M1 J+DELR 
GO TO 1125 
1135 J = J+l 

IF (J-NZONEZ) 1115.1115,1140 
1140 WRITE (6, 122) 

WRITE (6.113) <Z(J), J= 1 , NZP1 ) 

1150 IF (KBCREDI 1155,1155,1180 
1155 IF (NZUNEZ-1) 1180.1180,1160 
1160 K=0 
J =0 

DO 1175 JJ=i, NZONEZ 

REAL (5.110 (MIDI I I , i = l,NZONER) 

K = K +NM I ( J J ) 

1165 J=J+i 
1 = 0 

DO 1170 1 1= l.NZONER 
L = NMR1 I I ) 

DU 1170 KK= 1 , L 
1 = 1 + 1 

I J=INDEX ( NR. J, I ) 

1170 MA( I J ) = M I D ( i I ) 

IF (J-K) 1165,1175,1175 
1175 CONTINUE 


1180 WRI TE (6, 123) 

DO 1185 J = 1 » NZ 
IJ=INDEX(NR, J, 1) 


ou u u u 


K=i NDEX { NR , J « NR ) 

1185 WkITE (6,116) ( MA ( 1 1 , i = IJ,K) 


1200 IF (KflCRED) 1205, 1205, 1210 
1205 READ (5.112) (XKMIGI, I G = 1 , NG ) 
1210 WRITE (6,124) 

WRITE (6,113) (XKHIG), IG = 1,NGI 

1250 IF (KBCREG) 1255,1255,1375 
1255 IF < K DREAD ) 1300. 1300,1260 
1260 READ (5,112) IDR(M), M= 1 , NO ) 

IF (NZ-11 1270,1270, 1265 
1265 READ (5,112) (DZ(M), M=l,ND) 

1270 READ (5,112) (W(M), M-i ,ND) 


1300 IF (KCTYP-1) 1375,1305,1355 
C 

1305 WRITE (6,125) 

NTYPSl=NTYPS— 1 
KUP=KCGG-(KCTR*1) 

DO 1350 N= 1 ,NMA I 
WRITE (6,135) N 
L=0 

DO 131 C IG=1,NG 
DO 1310 K=i,NTYPS 
L-L + 1 

1310 010 = 0.0 
C 

DO 1325 IG=1,NG 
K1=INDEX(NTYPS, IG, 1) 

K2=IN0EX( NT YPS. IG.4) 

K 3= INDEX ( NT YPS, IG.NTYPS) 

READ (5,112) (C1(K). K=K1 ,K2) , TEMP, Cl ( K3 ) 
WRITE (6.113) (CHK), K=K1 ,K2 ) , TEMP ,C1 ( K3) 

IF ( NBUCK ) 1316,1316,1315 

1315 K1=IN0EX(NG*N, IGJ 
BUCKGl K 1 ) =TEMP 

1316 K1=INDEX(NIYPS, IG.3) 

K2= INDEX! NT YPS. IG.KCGGJ 
TEMP=C1 (K 1+1 ) 

IF ( ( KCGG*1 1— NTYP $ J 1319,1317,1317 

1317 IF (KUP) 1318,1318.1319 

1318 Cl( K2)=C1 ( Kl) 

GO TO 1322 

1319 IF (N2N) 1321, 1321, 1320 

1320 K3=1NDEX(NG,N, IG) 

CN2N(K3)=0(K1) 

1321 Cl< K2)=0.0 

1322 Cl(Kl)=TEHP 

IF (KUP) 1325.1325,1323 

1323 0( Kl + 1 ) = 0*C 
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1325 CONTINUE 


IE ( KCGG+ 1-NT YP S ) 13 30, 1 340, 1 340 

1330 WRITE (6. 105) 

I GEND=NG 

NGM 1 =NG— 1 
DU 1335 1G=1,NGM1 
IGEND= 1 G END- i 

IF { IGEND-(NTYPS-KCGG) ) 1331,1331,1332 

1331 K4=KCGG+IGEND-1 
GO TO 1333 

1332 K4=NTYPS 1 

1333 K1=IN0EX(N7YPS. 1G,KCGG) 

K2=INDEX(NTYPS, I G » K4 ) 

RE AO (5,112) ( C 1 ( K ) , K-K1.K2) 

1335 WRITE (6,113) (C1(K), K=K1,K2) 

C 

1340 IE (KUP) 1345,1345,1341 

1341 WRITE (6, 105) 

I G i=NG+ 1— KUP 
K3=KCTR+ 1 

00 1342 IG*IG1,NG 
K4=KCGC+IG— (NG+1) 

K 1 = INDEX( NTYPS, IG, K3) 

K2=IN0EX(NTYPS, IG,K4) 

READ (5,112) (C1(K), K=K1,K2) 

WRITE (6,113) (Ci(K), K=K1,K2> 

1342 CONTINUE 
C 

1345 CALL X STD SN ( N, KUP, MA , Cl, CN2N, 
1350 WRITE (6, 105) 

GO TU 1375 
C 
C 

1355 DO 1365 N= 1 * NMA T 
Kl= INDEX! NTYNG,N, 1) 
K2=INDEX(NTYNG,N,NTYNG) 

REAU (5,130) ( C ( K ) , K = K1.K2) 

IE (KSISU) 1360,1360,1356 

1356 DO 1357 IJ=1,NIJ 

IF ( ( MA ( I J )— 1 ) +N ) 1357.1358,1357 

1357 CONTINUE 
GO TO 1360 

1358 00 1359 IG- 1, NG 

K3= INDEX (NTYPS, IG.KCTR) 

K 3=K3+ 1 

K3-INDEX(NTYNG,N»K3) 

K4=INDEX(NTYPS, IG, NTYPS) 
K4=IN0EX(NTYNG,N,K4) 

DO 1359 K =K 3 , K4 

1359 C(K)=3.0*C(K) 

1360 IF (N2N) 1365,1365,1361 

1361 K 1= INDEX ( NG , N, 1) 

K2=INDEX( NG,N,NG) 

READ (5,112) ( CN2N( K ) , K=K1,K2) 


nor' ono r>o 


1365 CONTINUE 


1375 WRITE (6. 125) 

00 1390 N=1.NMAT 
WRITE (6.135) N 
00 1380 1G-1.NG 
K3=INDEX(NTYPS, 1G, 1) 
K4=INDEX(NTYPS, IG.NTYPS) 

Kl= INDEX! NTYNG.N.K3) 

K2= INDEX! NT YNG.N.K4) 

IF ( KBtREDI 1376,1376.1380 

1376 IF (KCTYP) 1377.1377,1380 

1377 READ (5.112) (C(K), K=K1,K2I 
1380 WRITE (6,113) (C(K), K=K1.K2) 


IF ( K6CRED ) 1385,1385.1390 

1385 IF (N2N) 1390,1390.1386 

1386 K1=INUEX(NG,N. 1) 

K 2= INDEX ( NG , N.NG) 

IF (KCTYP) 1390.1387,1390 

1387 READ (5.112) (CN2NIK) , K=Kl,K2) 

1390 WRITE (6.105) 

CALCULATING THE OUT SCATTERING (CN2N) 


IF (K8CKE0) 14GC, 1400,1660 

1400 IF (N2N) 1401.1401.1425 

1401 I TEMP 1=KCTR + 1 
00 1415 IG=1,NG 
DO 1415 M=1 . NMAT 
K= INDEX! NG.M, IG) 

CN2N( K )— 0. C 

00 1415 N=1TEMP1,NTYPS 
IF (N-KCGG) 1405,1415,1405 
1405 IGG=I G-KCGG4N 

IF (IGG) 1415,1415,1407 

1407 IF (IGG-NG) 140b. 1408. 1415 

1408 Kl= INDEX! NT YPS, IGG, N ) 

K 2= INDEX! NTYNG.M.Kl) 

CN2N( K ) =CN2N l K ) +C ( K2 I 

1415 CONTINUE 

CALCULATING SIG UP, OUT SCATTERING (CUPS) 

1425 IF ( ( KCTR+ 1 )— KCGG) 1426.1450,1450 

1426 I TEMP 1=KCTR+1 
ITEMP2*KCGG— 1 
CO 1435 1G=1,NG 
DO 1435 M=1,NMAT 
K= INDEXING, M, IG) 

CUPS(K)=C.C 

DO 1435 N=I TEMP 1. I TEMP 2 
IF (KREG) 1427.1427,1430 

1427 IGG=1 G— KCCG+N 

IF (IGG) 1435.1435,1428 
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non oo on oo no 


1 428 IF UGG-NG) 1425,1429,1435 

1429 K1=INDEX(NTYPS, 1GG.N) 

GO TO 1431 

1430 K1=INDEX(NTYPS, IG » N ) 

1431 K2= INDE X( NT YNG, M, K1 ) 
CUPS(K)=CUPS(K)+C(K2) 

1435 CONTINUE 


1440 IF (KUPS) 1450*1450,1441 

1441 DO 1445 IG*1,NG 
00 1445 M= 1 ,NMA T 
K= I NDE X ( NG, M , IG) 

IF < AB$(CUPS(K) H0.1E-7) 1443,1443,1442 

1442 KUP S= I G 

GO TO 1450 

1443 CONTINUE 
1445 CONTINUE 


1450 IF { LBUCK ) 1455,145 5, 1451 

1451 IF (KBCkEOi 1452, 1452, 1453 

1452 READ (5,112) (BUCLK(IG), IG=1,NGJ 

1453 WRITE (6,131) 

WRITE (6,113) (BUCLK(IG), IG=1.NG) 


1455 IF ( NBUCK ) 1465,1465,1456 

1456 IF ( KBCREC ) 1457,1457,1460 
145/ IF (KCTYP-1) 1458,1460,1458 

1458 DO 1459 N = 1 • NMA T 
Kl= INDEX! NG, N, 1) 

K2=lNDtX(NG»N*NG) 

1459 READ (5,112) (BUCKG(K), K=K1,K2) 

1460 WRITE (6, 132) 

DO 1461 N~ l ,NMA T 
K 1= INDEX ( NG , N , 1) 

WRITE (6,135) N 
K 2= INDEXING, N,NG) 

WRITE (6,113) (BUCKG(K), K=K1,K2) 

1461 WRITE (6,105) 


1465 WRITE (6, 134) 

DO 1466 N-l.NMAT 
WRITE (6, 135) N 
K1=IN0EX(NG,N. 1) 

K2= INDEX (NG,N,NG) 

1466 WRITE (6,113) (CN2N(K), K=K1,K2) 


1500 LOS=0 
L 2 S = 0 



1505 

1506 

1507 


1510 

1511 

1512 

1513 

1515 

1516 

1517 
1510 

1519 

C 

1525 

C 

1530 

1535 

1540 

1541 


1542 


1543 


1544 

1545 

1550 

1551 

1552 
1555 

C 

1560 

1561 

1562 

1563 

1564 

1565 


I JGS=0 

00 1590 1 G = 1 *NG 
1 JGST = I JGS + 1 
IJGSP=IJGS+NIJ 
IF (KBCKED) 1505* 1505* 1525 
IF (KFLUX1) 1525*1506,1530 
00 1507 IJG=IJGST. IJGSP 
XN< IJGI=i.O 

IF ( KS I SO ) 1560,1560,1510 

IF ( KBCRED ) 1511.1511,1513 
OU 1512 I JG=1 JGST * 1 JGSP 
X JR i I JG ) =1 . 0 
GO TO 1515 

CALL BCREAD i X JRCI JGST) , X JRI I JGSPI ) 
IF ( NZ— 1 ) 1560, 1560, 1516 
IF (KBCRED) 1517,1517,1519 
00 1510 1JG=IJGST, I JGSP 
XJZ( IJG)=1,Q 
GO TO 156C 

CALL BCREAO ( XJZI I JGST) , XJZI IJGSP) ) 
GO TO 1560 

CALL BCREAO ( XNU JGST) , XNll JGSPI I 
IF (KSISOJ 1560,1560,1510 


L=0 

REAO (5,118) ( ( NMRI I ) , RM1 ( I ) ) , 1=1,5) 
1=1 

IF (NMR ( I ) ) 1550,1550,1541 
L 1=L + 1 
L=L+NHR( I » 

IF (L-NIJI 1543,1543,1542 
WRITE (6,119) 

KEND= 1 
GO TO 1600 
ITEMP1=L1+IJGS 
1 T EMP2=L+i JGS 

00 1544 IJG=ITEPP1* I TEMP2 
XN( 1JG)=RMIII) 

IF (1-5) 1545,1535,1535 

1 = 1 + 1 

GO TO 1540 

IF (L-NiJ) 1551,1555,1555 
1 TEMP 1— I TEMP 2+1 
00 1552 IJG=ITEMPi. IJGSP 
XNl I JG)=0 • 0 

IF ( KS ISO) 1560,1560,1510 

IF ( KBCREO ) 1561,1561,1590 
IF (KRBC-1) 1562,1566,1566 
DO 156i 1=1* NONZNG 
XN0S4 1 ) =0*0 

IF (NZ-l) 1575,1575,1564 
00 1565 1=1, NONZNG 
XNOSUPi I)=0,0 
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GO TO 1575 
1566 CO 1570 J=l, NZ 

1 JG= INDEX I NZ t I G * J ) 

IJG=1JG*NR 

DO 1570 M=1#ND 

LOS=LOS+1 

XN0S1 LOS ) = XN( I JG ) 

1^ (NZ-l) 1570.1570,1567 
156/ XNQSUP ( LOS) =XN( IJG) 

1570 CONTINUE 
C 

1575 IF (KTBC-U 1576, 1578.157 8 

1576 00 1577 I=1,NXNZS 

1577 XNZSI I ) =0 • 0 
GO TO 1590 

1578 IF t NZ— 1 ) 1590, 1590, 1579 

1579 IJG=INZ-1)*NR 
IJG=IJG+INDEX(NK, 1G,0) 

DO 1580 1=1, NR 

I JG=I JG+1 
DO 1580 M=1.ND 
LZ S=L Z S + 1 

1580 XNZS(LZS)=XNI I JG) 

C 

C 

1590 I JGS= I J G SP 
C 
C 

c 

1600 RETURN 
C 

END 


90 


non no no nooononnoon 


$IBFTC XSTDSN DECK 

SUBROUTINE XSTOSN ( N, KUP, HA, Cl, CN2N, C ) 

SUBROUTINE TDSNXS IS TO OBTAIN TDSN CROSS SECTIONS FROM RP-2 
FORMAT CROSS SECTIONS. 


THE COMMON STATEMENTS 


COMMON 

/CALL1/ 

KCHAI N , 

KENO, 

KEEN 


COMMON 

/CALL2/ 

KBCRED, 




1 

KREG, 

KALC, 

KGEO, 

K8BC , 

KTBC, 

KL BC, 

2 

KRBC * 



NSN * 

NG, 

NZ. 

3 

NR, 

NTYPS , 

NM AT , 

LBUCK. 


KCTYP, 

4 

KS I SO • 

KGST, 

KCTR, 

KCGG , 

KDREAD , 

KFLUXI 

5 



ITMIMX, 

ITMIGM. 

NZONER, 

NZONEZ 

6 

KACCEL , 

KALC 1 • 

NFN, 

N2N , 


ITMPRT 

7 

K BC DUP , 

KACAV, 

KGAVE , 

KNIP, 

KEOIT, 


8 



GLAM, 

EIGEN, 

EPS, 

XNF, 

9 

RYE, 

UMAX, 

CALCX, 


OMEGA. 

OMEGAP 

COMMON 

/CALL3/ 





1 



HZ, 

> 

X 

BE, 


2 





KCA, 

KCF, 

3 

KQNV, 

KFINSH, 

KASDR, 

KUPS, 



4 

NBE, 

NO, 

NGP 1 , 

NZP1 , 

NRP1 , 


5 

Ni J, 

NTYNG, 

NDNZ , 

NDNR , 

NONI J, 

NDNZ NG 

6 

NXNZS, 

NAR, 

NCt 

NI JG, 

NBUCK, 


7 

I TMA * 

ITMI, 

ITMIST, 

ITMIGX, 

ITD , 


6 



NEGSOR, 


LZSAV, 


9 

7 IMEX, 

TIMEZ. 



SDGFG1 , 

SCALUP 

COMMON 

/CALL4/ 

EPG , 

EPGX , 

E PGM, 

EPGMP , 

1 



OMEGAS, 

OMEGPS • 



2 


EXTRA1, 

EXTRA2, 

EXTRA3 , 

EXTRA4, 

EXTRAS 

3 


KXTRAl, 

KXTRA2 » 

KXTRA3 , 

KXTRA4 , 

KXTRA5 


THE DIMENSION STATEMENTS 
DIMENSION MA ( 1 1 

DIMENSION C1UI, CN2NI1), CIll 

THE INTEGER FUNCTIONS 

INDEX I LENGTH, INDEXO , I NDEXL J =LENGTH* ( I NDEXO- 1 1 + 1 NDE XL 


1000 KCTRPl=KCTR+l 
KUP i=KUP+ 1 

NT YP S l*N T YP S— l 
KSI=0 

IF (KSISC) 1010, 1C10, 1001 

1001 00 1005 IJ=1,NIJ 

IF I MA ( I J ) +N ) 1CC2, 1003,1002 

1002 IF I I MAI I J )— 1 ) ♦N) 1005, 100 A* 1005 



o o 


1003 KSI=-1 

GO TO 10 1C 

1004 KSI = l 

GO TO 101C 

1005 CONTINUt 


1010 DO HOC IG=1,NG 

L= INDt X ( NTYPS, IG. 1) 
K1=INDEX1NTYNG.N.U 
K 1=K 1— 1 

IF (KSI) 1011,1011,1013 

1011 K3=Kl+l 
K4=K 1+NTYPS 

00 1012 K=K3,K4 

1012 C 1 K ) = 0 .0 
GO TO 1020 

1013 K3=K 1+1 
K4=Ki+KCTK- 1 

00 1014 K=K3,K4 

1014 ClKI=0.0 
K3=K4«-2 
K4=K l+NTYPS 

00 1015 K=K3.K4 

1015 C1K)=0.0 
C 

1020 K=K1+KCTR 

IF IKS1) 1022.1021,1025 

1021 Cl K )= 1 .0/ ( 3 .0*0 11 L • ) 

GO TO 1023 

1022 K3=L+NTYP$1 
C 1 K ) =C 1 1 K3 ) 

N1=N+1 

K3*=INUEX(NTYNG.N1.L ) 
K3=K3+KCTK-1 
CIK3)=l»0/( 3. 0*C 1 < L ) > 

1023 C(K-l)=CllL+2» 

Cl K— 2 ) =C 1 (L + 1 J 
GO TO 1030 

1025 K2=K1+KCGG 
CIK2»=C1IL) 

C 

1030 K 3=KCT R— 3 

IF 1 K3 ) 1040. 104U, 1031 

1031 K2=K— 3 
1035 CIK2)=0.0 

K2=K2— 1 
K3=K3— 1 

IF (K3I 1040.1040,1035 
C 

1040 K2=K 1+KC GO 

IF (K.SI1 1041, 1041. 1C50 

1041 C(K2)=C(K l-CHL + l > 

IF 1N2N) 1043,1043,1042 

1042 K4= INDEXING, N. IGI 
C(K2)=C1K2»-CN2N1K4) 


non on 


GO TO 1050 

1043 DO 1045 K3=KCTRPI,NTYPS1 

K4=L+K3— 1 

1045 C(K2) = CI K2)-C.HK4) 

C 

1050 If- UG-NG) 1055,1075,1075 
1055 IF UG + KUP-NGI 1G #3, 1060, 1060 
1060 K=K2 

K3=KCTR 
IG 1= I G 
L=0 

KUP 1=KUP 1-1 
L 1 = 0 

1065 L 1=L l-f 1 

/IF IL1-KUP1) 1070,1070,1075 
1070 K=K— 1 

K3=K3+1 
IG 1-IGl+l 
L = L + 1 

K4=IN0EX(NTYPS, 1G1,K3) 

C(K) = CHK4J 

IF i L— KUP I 1065,1075,1075 
C 

1075 IF ( I G— 1 ) 1100,1100,1080 
1080 L= 1 

K3=KCGG— 1 
IG 1=1 G 

1085 K2=K2+ 1 
K3=K3+ 1 
I G 1= I G 1— 1 
1 = L + 1 

K4= INDEX! NT YPS , IGl,K3) 
CIK2)=C1(K4) 

IF ilG-L) 1100,1100,1090 
1090 IF ( ( K2— K 1 )— NTYPSI 1065,1100,1100 


1100 CONTINUE 


RETURN 


C 


END 



$1BFTC SETUP DECK 

SUBROUTINE SETUP (XKI, X KE * MA f V, AR, AZ, DELZ, OR, DZ ♦ 
1 MR , W, R, Z, RM, RA, RAV, L)ZL ) 

C 

C SUbROUT 1 Nfc SETUP CuMPUTES VARIOUS UUA N T I TIES NEEDED FOR EVERY 

C 1 TERAT IUN. 

C 

C 

C 

c 

L 

C 

C 

C THE CUMhuN STATEMENTS 


COMMON 

/CAL LI/ 

KCHAIN, 

KEND, 

KEFN 


CLMMUN 

/CALL// 

KBCRED , 




1 K KEG • 

KALL. 

KGEO , 

KHBC , 

KTBC, 

KLBC, 

2 KRbC, 



NSN * 

NG, 

NZ, 

3 NR. 

NTYPS, 

NMAT , 

LBUCK, 


KCTYP, 

4 KSISLJ. 

K G S T » 

KCTK, 

KCGG , 

KD RE AD , 

KFLUX I , 

6 


ITMIMX, 

1 TMIGM, 

NZUNER, 

NZONEZ , 

6 KACCEL, 

KALC 1, 

NFN, 

N2N , 


ITMPRT, 

7 KBCDUP, 

KACAV, 

KGAVE , 

KNI P, 

KEDIT , 


ti 


GLAM, 

EIGEN, 

EPS, 

XNF , 

9 RYF, 

T IMAX, 

CALC1 , 


OMEGA, 

OMEGAP 

COMMON 

/CALL 3 / 





1 


HZ, 

HY, 

BF, 


2 




KC A , 

. KCF , 

3 KONV, 

KFINSH. 

KASOR, 

KUPS, 



4 NBF, 

ND, 

NG PI • 

NZ PI • 

NR Pi , 


6 NI J* 

NTYNG, 

NDNZ , 

NUNR, 

NDNI J , 

NDNZNG. 

6 NXNZS, 

NAR, 

NC , 

NI JG, 

NBUCK , 


7 1 1 M A , 

I T M I , 

ITMIST, 

ITMIGX, 

1TD, 


a 


NEGSOR, 


LZSAV, 


9 TIMEX, 

TIMEZ, 



SDGFG1 , 

SCALUP 

COMMON 

/CALL4/ 

EPG, 

EPGX , 

E PGM , 

EPGMP, 

1 


OMEGAS, 

OMEGPS, 



2 

EXTRA1, 

EXTRA2, 

EXTRA3, 

EXTRA4 , 

EXTRAS, 

3 

KXTRA1, 

KXTRA2 , 

KXTRA3, 

KXTNA4, 

KXTRA5 

COMMON 

/CSETUP/ 

KALCP1 , 

A VF , 

PI , 

GLAMP, 

1 EXTRP 






Tht 0 1 M fc i\ S . 

ION STATEMENTS 




DIMENSION 

XX 1(1), 

XKE ( 1 ) , 

MAI 1) 


DIMENSION 

V( 1 ) , 

AR ( 1 ) 

, 

AZ( 1) , 


1 

DEL Z ( 1) , 

DK l 1 ) 

, 

DZ ( 1 ) , 


2 

MR( 1 ) , 

hi 1) 




DIMENSION 

R( 1) , 

Z( 1) , 


RM ( 1 ) , 


1 

RA ( 1 ) » 

RAV ( l ) , 

OZlIi) 



C 

C THE FORMAT STATEMENTS 

111 FORMAT (71161 
113 FORMAT ( 7E 16.3) 

1 22 FORMAT ( 1EL ,2X,22HUIRECTI0NAL FUNCTIONS ) 
130 FORMAT ( lEj.2HJ = , 13) 
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141 FORMAT (1HL.32HTHE MESH CELL VOLUMES ( V 1 N2 , NR ) ) ) 

142 FORMAT <1HL,I6,37H NEGATIVE VOLUMES HAVE BEEN COMPUTED.! 
C 

C THE INTEGER FUNCTIONS 

INDEX! LENGTH. INDEXO. INDE XL J = LENGTH* { I NDE XO-1 H-INDEXL 
C 

c 

C COMPUTE INITIAL VALUES. 

C 

10U0 PI=3. 141 59265 

GO TO 11005,1010,1015!, KGEO 
1005 AF=1.0 
VF= 1. 0 
GO TO 1020 
1010 AF=2.0*PI 
VF=0. 5 
GO TO 1020 
1015 AF=4.Q*PI 
VF=1. 0/3.0 
1020 SDGFG 1=0. 0 
C 

c 

IF (ITMISTJ 1025. 1025,1200 
1025 GL AMP = 0. 0 
EXTRP = 0* 0 
C 

c 

C COMPUTE SN CONSTANTS. 

C 

c 

1050 IF CKBCRED) 1051,1051,1200 

1051 IF I K DREAD ) 1055,105 5,1052 

1052 DO 1053 M= 1 • ND 

1053 W(Mi=W<M)/AVF 
GO TO 1150 

1055 IF i ND— ( NSN+ 1 ) ) 1125,1125.1060 
C 

C CODED FOR CYLINDERS AND TWO DIMENSIONAL SLABS. 

C 

1060 NSNC2=NSN/2 
AREA=0.0 

DO 1065 M=1*NSND2 
VM = M 

1065 AREA=AREA+ VM 
M=0 

TEMP=0.0 
DZ 1IM + 1) = 1.0 
1070 M=M+ 1 

IF ( M— NSND2 ) 1075,1080,1080 
1075 VM=M 

TEMP = T EMP + VM 

DZ HM* 11= 1.0-1 TEMP/AREA) 

GO TO 1070 
1080 DZ 1 ( M+ 1 ) = C • 0 
C 

SN=NSN* l N SN +2 ) 



DZF=$QRI< SN/I SN— 2.0 ) ) 

CZF-OZ F/2. 0 
M=0 

M 1 = 0 

1100 M=M + 1 

IF ( M— NSND2 ) 1105,1105.1150 
1105 L = 0 

MT2=2*M 
VMT 4=4*M 
Ml-Ml+1 

OZ2=OZF*(DZUM + 1)^OZKM) ) 

0 1= SORT ( 1.0- < DZ2*DZ2) I 
DZ I M 1 ) =UZ2 
DR( M 1 )=— D i 
W( M 1 ) -0« 0 
1110 L=L ♦ 1 

IF U-MT2) 1115.1115,1100 
1115 Ml-Ml+1 

DZ(M1)=DZ2 
VLT 2= l 2*L )— 1 

PHI =P I * ( 1.0— (VLT2/VMT4) ) 

COSPHI-CGSIPHI ) 

DR( Ml) =D1*C0SPH1 
WiMl )=< l.C/(2.Q*AREA)|/AVF 
GO TO 1110 
C 

C COOED FOR SPHERES AND ONE DIMENSIONAL SLABS. 

C 

1125 NSND2-NSN/2 
SN-NSN 
AREA-2. O/SN 
M-0 

02 1 ( M + 1 ) = 1 .0 
1130 M-M + l 

IF I M-NSN02 ) 1 135. 1 1 AO, 1140 
1135 OZ UM+lJsDZHM )— ARE A 
GO TO 1 13G 

1140 DZ 1 ( M+ 1 ) *C. C 
C 

DZF- SN/ SORT ( ( SN**2)-i.Q) 

CZ F-DZF/2 . 0 
M- l 

DR ( M ) =— DZ 1 ( M ) 

W< M ) = 0. 0 

1141 IF (M-NSNO?) 1142.1142,1143 

1142 M=M + 1 

UR ( M ) =- DZ T * < 0 Z 1 I M I +DZ 1 ( M- 1 ) ) 

W ( M ) = ( 1.0/SN ) /A VF 
GO TO 1141 

1143 L-0 

1144 L=L+1 

IF (L-NSND2) 1145,1145,1150 

1145 M=M+l 

M 1= ( NSND2 + 2 )— L 
DR( M ) =-DR (Ml) 

W ( M ) =W (Ml) 
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non nnnn non 


GO TO 1144 


c 

1150 M1=ND 

1155 W0=AVF*W(Mi)*DR(Mi) 

IF IABSC inD)— 0.1E— 07) 1 160, 1160 ,1156 

1156 IF (WD) 1170.1160,1165 
1160 MR( M 1 )=MR ( M 1 + 1 1 

1165 Ml=Ml-i 

IF (HI) 120C.1200.1155 
1170 M=M 1 
1175 M=M+ 1 

IF ( 1*0£— 04—ABS(DR( H )+DR( Ml) ) ) 1175.1180.1160 
1180 MR(M)=M1 
MR<M1)=M 
GO TO 1165 

COMPUTE INI TAL FUNCTIONS. 

1200 IF (ITMA) 1305. 13C5. 1365 
1305 IF IKALC1-1) 1325,1310.1325 
1310 00 1315 IG= 1 ,NG 
1315 XKI(IG)=XKHIGI/CALC1 
1325 XK I ( NGP 1 ) =0.0 

00 1330 IG=1.NG 
XKI ( NGP 1 )=XKI(NGP1)+XKI ( IGI 
1330 XKE( 1G) =XK II 1G ) 

XKE( NGP 1)=XKH NGP II 


1350 DO 1360 l =1.NRP 1 
1360 R A ( 1 ) =R ( I i 

MODIFY RADII. 

1365 GO TO C 1400. 140C. 1400. 1400. 1370,1385) . KALCP1 
1370 00 1375 1*1. NR 
K=MA( I I 

RAl I + l)*fUm + !R( 1+ U— R(I ) ) ♦( 1 .0+E IGEN*RH(KI) 
IF { !• 0+E IGEN*RM( K ) ) 1380,1375,1375 
1375 CONTINUE 

GO TO 1400 
1380 KEFN= 13 70 
KEN0=1 
GO TO 1600 

1385 00 1390 I =1, NRP 1 

1390 RA( I)=EIGEN*R(I)/R(NRPl) 


COMPUTE AREAS AND VOLUMES. 

1400 IF (ITMA) 1410.1410,1405 

1405 GO TO ( 1500, 150C, 1500, 1500.1410,1410) • KALCP1 

1410 GO TO 11411.1415,1450). KGEO 

1411 IF (NZ-1) 1450,1450,1415 
1415 DO 1420 1=1, NR 

IP 1=1 + 1 

RAV ( I ) =0 • 5* (RA( IP 1)+RA( I ) ) 

GO TO (1416,1417,1420), KGEO 
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1416 AR( 1) = AF 

AZ( I ) = RA( 1P1)-RA( I ) 

GO TO 1420 

1417 AR( I )=AF*RA( I ) 

A Z( I ) = AF*RAV ( I )*(RA( IPD-RAI I ) ) 

1420 CONTINUE 

GO TO (1421,1422,1450), KGEO 

1421 AR(NRP1)=AF 
GO TO 1423 

1422 AK( NRP 1 ) = AF*RA1 NKP 1 ) 

1423 J=1 

DELZl J)=1.0 

IF (NZ-1) 1430,1430.1425 
1425 JPl=J*l 

DELZ ( J)=Z< JP1 I— Z ( J) 

1430 I T EMP = 0 

DO 1440 1=1, NR 
I J = INDEX ( NR , J , I ) 

V< I J ) =AZ ( 1 ) *QELZ ( J ) 

IF (V(IJ)) 1435,1440,1440 
1435 1 TEMP=I TEMP + 1 
1440 CONTINUE 

IF (NZ-J) 1475,1475,1445 
1445 J=JP1 

GO TO 1425 
C 

1450 DO 1465 I=1,NRP1 

GO TO (1455,1465,1460). KGEO 
1455 AR ( 1 )=AF 

GO TO 1465 

1460 AR( I )=AF*(RA( I )**2) 

1465 CONTINUE 
I T EMP=0 

DO 1470 1 = 1, NR 
RAV(I)=0.54(RA(I*1)+RA(D) 

V( I ) = VF*( AR( 1 + 1)*RA( 1 + 1)-AR( I ) *RAU ) ) 
IF IVIII) 1469,1470,1470 

1469 ITEMP=I TEMP+1 

1470 CONTINUE 
DELZ ( 1 ) =1 .0 

C 

1475 IF (ITEMP) 1500.1500,1480 
1480 WRITE (6,142) ITEMP 
KEFN= 1480 
KEND=1 

PRINT SUME SETUP QUANTITIES, 

1500 IF (ITMA) 1505,1505,1501 

1501 IF (KBCRED) 1575,1575,1505 
1505 WRITE (6.141) 

DO 1510 J=1,NZ 
WRITE (6,130) J 
K1=INDEXINR, J, 1) 

K2= INDEX (NR, J,NR ) 

1510 WRITE 16,113) (V(IJ), IJ=K1,K2) 



non no non 


C 


WHITE 16.122) 

WRITE (6*113) ( DR( M) , M=1,ND) 
IF <NZ— l) 1520, 1520. 1515 
1515 WRITE (6,113) (DZ(M), M=1,N0) 
1520 WRITE (6,113) (W4M), M=1,N0) 
WRITE (6,111) ( MR ( M ) , M=l,ND) 


1550 IF ( KBCRED) 1575,1575,1555 
1555 IF i NFN— I ) 1600.1560,1600 
1560 DO 1565 IG=l.NGPi 
1565 XKE(IG)=XKl(iG) 

GO TO 1600 


1575 NFN = 1 


1600 RETURN 
C 

END 


$ I EM AP BCREAD 60,M94,DECK 

7CS4 RELMOO ASSEMBLY. 


$ IBLDR BCREAD 
STEXT BCREAD 
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BCREAD SUBROUTINE FOR IBSYS 


ENTRY BCREAD 

BINARY CARD ID* BCREAUOO 

OOOOQ I OOOOO 0 00005 10001 BCREAD SAVE 1*2*4 

U0001 0774 00 2 COOOO 10000 

00002 0774 00 1 OOOOO 10000 

00003 0774 CO 4 OOOOO 10000 

00004 0C2C 00 4 00001 10000 

00005 0634 00 4 06000 10011 

00006 0634 00 4 00110 10001 

00007 0634 00 4 00003 10001 

00010 0634 OC 1 00002 1000L 

00011 0634 00 2 00001 10001 

00012 0500 CO 4 00003 10000 C LA 3*4 PICK UP THE FIRST ARGUMENT 

00013 0560 00 4 00004 10000 LDO 4,4 PICK UP THE SECOND ARGUMENT 

00014 0040 00 C 01002 10011 T LO *+2 MAKE SURE THE LARGEST 

00015 0131 00 C OOOOO 10000 XCA ARGUMENT IS IN THE AC 

00016 4600 OC 0 00107 10001 STQ TEMP 

00017 04C2 00 0 00107 10001 SUB TEMP 

00020 0734 00 l OOOOO 10000 PAX 0,1 PUT WORD COUNT + 1 

00021 1 00001 1 01001 10011 T X I *+l,ltl INTO INDEX 1 

00022 0534 00 2 00107 10001 LXA TEMP, 2 PICK UP THE FIRST LOAD ADDRESS 

BINARY CARO ID. BCREADO 1 

00023 0634 00 1 00037 10001 SXA 1X1,1 

00024 0634 00 2 00040 10001 SXA 1X2,2 

00025 C5CC 60 0 00105 10001 CLA* I N5 

00026 0621 00 0 01002 10011 STA *+2 

00027 0C24 OC 4 07000 10011 TSX .CLOSE, 4 

00030 5 OOOOO 0 OOOOO 10000 MON ** 

00031 05C0 60 0 00106 10001 CLA* READS 

00032 0621 00 0 00036 10001 STA MON 

00033 0621 00 0 00044 10001 STA READ2 

00034 0621 00 0 00065 10001 STA SHUT 

00035 0 C 74 00 4 10000 10011 TSX .OPEN, 4 

00036 5 COOOO 0 OOOOO 10000 MON MON ** 

00037 0774 00 1 OOOOO 10000 1X1 AXT **,1 HOLDS THE WORD COUNT 

00040 0774 00 2 OOOOO 10000 1X2 AXT **,2 HOLDS THE LOADING ADDRESS 

00041 0634 00 2 00047 10001 SXA SXA 10,2 

00042 7 00026 1 00053 10001 TXL LASTC,L,22 

00043 0074 00 4 11000 10011 READ TSX .READ, 4 

00044 0 00067 C OOOOO 10100 READ2 PZE **,,EQB 

00045 0 00074 0 00100 10101 PZE EGF , , ERR 

BINARY CARO ID. BCREAD02 

00046 4 00002 2 OOOOO 10000 IOCPN **,,2 SKIP FIRST WORD AND CHECKSUM 

00047 0 C0026 0 OOOOO 10000 10 10CD **,,22 

00050 1 77752 l C1001 10011 TXI *+1,1, -22 

00051 1 00026 2 01001 10011 TXI *+1,2,22 

00052 OC20 OC C 00041 10001 TRA SXA 

00053 0500 00 0 00057 10001 LAST C CLA DONE 

00054 0601 UO 0 41002 10011 STO *-2 

00055 4634 00 1 00047 10001 SXO 10*1 REDUCE THE WORD COUNT 

00056 CC20 00 0 00043 10001 TRA READ 

00057 CC2C 00 0 01001 10011 DONE TRA *+ L 
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00060 

0774 

00 

4 

00041 

10001 


AXT 

SXA *4 

00061 

0634 

00 

4 

00052 

1000X 


SXA 

LASTC-1.4 

00062 

0774 

00 

4 

00026 

10000 


AXT 

22*4 

00063 

4634 

OC 

4 

00047 

10001 


sxo 

10*4 

00064 

0C74 

00 

4 

07000 

10011 


TSX 

• CLOSE* 4 

00065 

5 CGQOO 

0 

00000 

10000 

SHUT 

MON 

** 





00066 



RETURN 

BCREAD 

00067 

CCOOOOOOOOOO 

00010 

EOB 

CALL 

.FXEM.iEO 

00067 

0074 

00 

4 

04000 

10011 





BINARY CARO 10. UCKEAD03 


00 070 

1 

00001 

0 

01003 

10011 




00071 

0 

00110 

0 

000 74 

10100 




00072 

0 

00000 

c 

00104 

10001 




00073 

0020 UO 

0 

00100 

10001 


TRA 

EOF 

00074 

ococoooooooo 

00010 

ERR 

CALL 

•FXEM. ( ERR2 ) 

00074 

0074 00 

4 

04000 

10011 




00075 

1 

€0001 

0 

01003 

10011 




00076 

0 

00110 

0 

00076 

10100 




00077 

c 

00000 

0 

00103 

10001 




00100 

000000000000 

00010 

EOF 

CALL 

EXIT 

00100 

0C74 00 

4 

05000 

1001 1 




00101 

1 

cocoo 

0 

01002 

10011 




00102 

0 

CC110 

0 

00077 

10100 




00103 

0 

00000 

0 

00043 

10000 

ERR2 

PZE 

35 

00104 

0 

00000 

0 

00044 

10000 

E0B2 

PZE 

36 

00105 

0 

00000 

0 

12000 

10011 

IN5 

PZE 

• UN05 • 

00106 

0 

00000 

0 

13000 

10011 

READ5 

PZE 

• READ5 

00107 

0 

00000 

0 

00000 

10000 

TEMP 

PZE 


00110 

CCOOOOOOOOOO 

10000 


♦ LOIR 



BINARY CARO 10. BCREAD04 

00111 2^351252124 10000 

00000 01111 END 


CONTROL DICTIONARY 

SCDICT BCREAD 


BINARY CARO 10. BCKEA006 

OOC1120COOOO PREFACE START=0,LENGTH=74, TYPE=7094, CMPL X= 5 

OCOC04000005 


222351252124 

BCREAD 

DECK 

L0C=0 

* LENGTH=74 

000112000000 

222351252124 

BCREAD 

REAL 

LOC-O 

• LENGTH=0 

ococooocoooo 

222351252124 

BCREAD 

REAL 

L0C=0 

* LENGTH=0 

CCOOOOOOOOOO 

332667254433 

.FXEM. 

VIRTUAL 

SECT. 

4* CALL 

2COOCC1COOOO 

256731636060 

EXIT 

VIRTUAL 

SECT. 

5, CALL 

2C0CCC1C0000 

627062434623 

SYSLOC 

VIRTUAL 

SECT. 

6 

2CCGOOOOOOOO 

332343466225 

.CLOSE 

VIRTUAL 

SECT. 

7 

20CGCOOCOOOO 

334647254560 

.OPEN 

VIRTUAL 

SECT. 

8 

2CCCCOOCOOOO 

335125212460 

.READ 

VIRTUAL 

SECT. 

9 

2CUUCG0C0000 

3364450C0533 

• UN05. 

VIRTUAL 

SECT. 

10 

2CCOOOOGOOOO 

BINARY CARD IC. BCREAD07 

335125212405 

•READ5 

VIRTUAL 

SECT. 

11 


2CCOCCOCOOOO 

SOKE NO BCREAO 
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SYMBOL REFERENCE DATA 


REFERENCES TO L)EF 1NED SYMBOLS. 


CLASS 

SYMBOL 

VALUE 

REFERENCES 


BCR E AD 

00000 

66 


DONE 

00057 

53 


E0B2 

001G4 

72 


EOti 

00067 

44 


EOF 

00100 

45,73 


ERR2 

00103 

77 


ERR 

00074 

45 


INS 

00105 

25 


10 

00047 

41,55.63 


IXi 

00037 

23 


1X2 

00040 

24 


..U001 

OOOC3 

7, 10.11 


..0002 

00004 



. .00 C3 

000C5 

0 


L AST C 

00053 

42,61 


MON 

U0036 

32 


READ2 

00044 

33 


READS 

00106 

31 


READ 

00043 

56 

LCTR 

8LCTR 



DUAL 

UNO S 



LCTR 

// 




SHUT 

00065 

34 


SXA 

00041 

52,60 


TEMP 

00107 

16, 17,22 


REFEkENCES TO VIRTUAL SYMBOLS. 


EXIT 

5 

100 

• CLOSE 

7 

2 7,64 

• FXEM . 

4 

67,74 

.UPEN 

8 

35 

-KEA05 

11 

106 

.READ 

9 

43 

.UN05. 

1C 

105 

SYSLUt 

6 

5 


$ IBMAP . READ5 5, DECK 

709 A RtLMUu ASSEMoLY. 


$ I bL UK .REAOd u2/25/66 

$ F 1 L E .READS 'READS •* 1 N1 # KfcAUY • 1 NPU # BLK = 2b • MULT iREtL . MXblN « .:UL I S T 


.KEaUOOO 

.KEAOJOl 
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FILE UICT ICNARY « 

♦EDICT • READS .REA0002 


BINARY CARO iL. .REAOCCJ 

6C4CU200GG;}4 READS FILE •kEAC 5 MX 3 1 N * l N PU T , N U HC V N t d L K = 2 b 

OCOuGGGOOuOO 

S12S212*tG56C 

6CbC6C6C6U60 

ECEC6C6C6G60 

$TtXT ♦READS •RtADDOA 





ENTRY 

•READS 

BINARY 

CARD ID. • RE AOOOS 
OUGOO C GOoQG 0 04001 

COUuO 

100 1G -READS 
READS 

Uilll 

PZE 

FILE 

END 

READS 

,IN 1, READY, INPUT , BLK.-2B , MUL T I REEL • MXBI t\ tNOL 1 ST 


CONTROL DICTIONARY 





4CD1CT .READS 


♦REAUGU6 

BINARY 

CARL ID. .REAOOU7 

GCCGulGQOOOO 

0OGCG4GUJGGS 

33512S212405 

COCOGIOOOOOO 

33S12S2124C5 

GCOCOCGOCGUU 

PREFACE 
♦READS DECK 
♦READS REAL 

START=0,LENGTH=l,TYPE=7Uy4. CMPLX=S 
L0C=0 , LENGTH^ 1 
L0C = 0, LENGTHS 


4DKEND .READS 0U1164 .REAOOUB 

SYMBOL REFERENCE DATA 


REFERENCES TO OEFiNtO SYMBOLS. 


CLASS 

SYMBOL 

VALUE 

REFERENCES 


.READS 

CGOCC 


file 

reacs 

1 

0 

LCTR 

BLCTR 



QUAL 

UNCS 



LCTR 

// 
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SIBFTC OUTER DECK 

SUBROUTINE OUTER IXKI.XKE, MA,C, XI, 

1 FG * F, XNOS »XNGSUP» XNZS, XN, XJR.XJZ, V » AR » AZ » DELZ , 

2 KF I NG , KASQRG • AG , F NG , SG , A SG , SC G , SDG , S I NG , XNG , X NB, HNLG , 

3 VNL G , XNLGt CT ,CGG »CGGA , T VLK » S I SO . S T , ARS I SO , AZS I S U , ARS T , 

4 AZ S T , CC * BNLG » CUPS,CN2N, XNM , XNN.XNA, 

5 XJRN.XJZN* X JKA • X J Z A « X2 . BUCLK • BUCKG, 

6 MXVAK 1 , E S I JM ) 

SUBROUTINE UUTEK IS THE OVERLAY (OR CHAIN) SUBROUTINE OF TDSN 
THAT PREFORMS THE OUTER (OR MAJOR) ITERATIONS. 


C 

c 


THE COMMON 

STATEMENTS 


COMMON 

/CALL 1 / 

KCHAIN, 

COMMON 

/CALL2/ 

KBCRED, 

1 KREG . 

KALC, 

KGEO. 

2 KRBC • 



3 NK. 

NTYPS, 

NMAT, 

4 KSISO, 

KGSf . 

KCTR , 

5 


ITMIMX, 

6 KACCEL, 

KALCI, 

NFN • 

7 KBCDUP, 

KACAV, 

KGAVE, 

8 


GLAM, 

9 RYF ♦ 

TIMAX, 

CALC 1 , 

COMMON 

/CALL 3/ 


1 


HZ, 

2 



3 KONV. 

KFINSH, 

KASOR, 

4 NBF « 

ND. 

NGP 1 , 

5 NIJ, 

NTYNG, 

NONZ , 

6 NXNZS, 

NAR, 

NC, 

7 I TM A , 

I TM I , 

ITM1ST, 

8 


NEGSOR, 

9 TIMEX, 

TIMEZ. 


COMMON 

/CALL4/ 

EPG , 

1 


OMEGAS. 

2 

EXTRA 1 , 

EXTRA2, 

3 

KXTRAl, 

KXTRA2 . 

COMMON 

/COUTER/ 

KDR, 

1 KNI • 

KNO, 


2 KNORUP. 

KNZR. 

KNR, 

3 

KNZ 


COMMON 

/CINNER/ 

ITMIG. 

I XITGG. 

XI1GGA, 

LG, 


KENU, 

KEF N 


KBBC , 

KTBC, 

KLBC, 

NSN , 

NG, 

NZ, 

LBUCK » 


KCTYP, 

KCGG • 

KDREAO, 

KFLUX I , 

I TMIGM, 

NZONER, 

NZONEZ, 

N2N , 


ITMPRT, 

KNIP, 

KEOIT, 


EIGEN, 

EPS, 

XNF, 


OMEGA, 

GMEGAP 

HY, 

BF, 


KUPS. 

KCA, 

KCF, 

NZP1 , 

NR PI , 


NONR , 

NDNIJ, 

NONZ NG, 

NI JG. 

NBUCK, 


ITMIGX, 

I TO , 
LZSAV, 



SOGFGL, 

SCALUP 

EPGX, 

OMEGPS, 

E PGM, 

EPGMP, 

EXTRA3 , 

EXTRA4, 

EXTRAS , 

KXTRA3, 

KXTRA4, 

KXTRA5 

KOZ, 

KMR, 

KW, 

K 1 80 , 

KWHITE, 

KNOR, 

KJRR, 

KJZR, 


IG, 

IZ. 

JUP, 

NEGPRT, 

JZ, 

KX 


THE DIMENSION STATEMENTS 
DIMENSION X 1 ( I) , 

DIMENSION XKIi I), 

DIMENSION MAI 1), 

DIMENSION FG ( I ) , 


X2U) 
XKEU) 
C< 1) 
FID 



DIMENSION 

XNOS ( 11 , 

XNOSUP II), 

xNzsm 

DIMENSION 

XNI 11. 

xjRin , 

XJZ 4 1 J 

DIMENSION 

VI 1). 

ARID , 

AZ 4 1 ) , 

1 

DELZ41) 



DIMENSION 

KFINGl 1). 

KASORGf 11 


DIMENSION 

AG4 1), 

FNG ( 1 ) • 


1 

SGI 1 ) , 

ASG41J , 

SCG ( 1 ) , 

2 

S0G4 11, 

SINGH). 

XNGil), 

3 

XNBI 1), 

HNLG4 1 ) , 

VNLG41) , 

4 

XNLG41I, 

BNLG4 1 ) 


DIMENSION 

CTI1J. 

CGGU). 

CGGAm, 

1 

TVLK4 1), 

sisom • 

STCU, 

2 

ARSIS04 1), 

Azsisom, 

ARST(l) , 

3 

AZSTI 1). 

OCIll 


DIMENSION 

XNM41) 



DIMENSION 

XNN4 11, 

XJRNIll , 

XJZN(l) 

DIMENSION 

XNAI1), 

XJRA41), 

XJZA41I 

DIMENSION 



BUCLKI1) 

1 

BUCXG4 1), 

MXVARI Cl), 

ESIJMI1) 

DIMENSION 

CUPS41). 

CN2NI 1 ) 



C THE FORMAT STATEMENTS 

100 FORMAT { 1H1I 

104 FORMAT 4 1HL .2 1HPR0GRAM STOP AT KEFN=,I8) 

120 FORMAT ( 126H ITMA ITMI ITMIGX I TO TIME REQ EPG 

IEPGM KASGR KONV KFINSH NEUTRON BAL Gt AM E 

2IGEN ) 

121 FORMAT ( 14. 16, 14, I 7, 3E 14,. 6, 1 4, 1 5. 16 ,E1 8. 8.2F16.6 ) 

122 FORMAT 4 20X • 4HUPS2 » 0X.9HXNG 4 NGP 1 ) ,4X,10HSINGI NGPil »5X, 

1 9HS DG4NGP1I* 5X* SHAG! NGPl J *5X« 1 OHHNLG ( NGPl ) ,4X * 10HVNLG4 NGPl ! * 

2 4X • 1CHXNLGINGP1I) 

123 FORMAT 4 15X.8E14.6) 

124 FORMAT 4 1H J 

125 FORMAT ( 5X . 5HGR0UP. 5X, SHI TMIG . 10X .10HFLUX ERROR, 7X . I 1HERR0R RATIO, 

1 5X» 12HF0RMER RATI 0, 8X, 6HFAC TOR ,12X,5H0MEGA) 

C 

C THE INTEGER FUNCTIONS 

INDEX! L ENGTH* INOEXG, I NDEXLI =LENGTH* ( I NDEXO— 1 I + INDEXL 
C 
C 

c 


1000 ITMI^ITMIST ,1 

IF I KBCRED) 1005,1005,1020 ,2 

1005 KONV=0 ,3 

IF ! NFN— 1 ) 1025.1010,1025 ,4 

1010 CALL F IS ION < MA. V, C. FG. XKE • XN, XJR, XJZ* F, XNOS, XNOSUP, 

1 XNZS I ,5 

IF CNEGSOR) 1025,1025.1015 ,6 

1015 KEND^l ,7 

WRITE 46* 1041 KEFN ,8 ,9 ,10 

KEFN=1015 ,11 

GO TO 2570 ,12 

1020 KBCRED=0 

C ,13 

1025 IF 4 I TMPRT) 1050,1050,1030 ,14 
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r> r n n o n o n n n n n 


1030 WRITE (6, 100) 

WRITE <6.120) 

WRITE <6.122) 

WRITE <6.124) 

IF UTMPRT-2) 1050. 1035.1035 
1035 WRITE <6, 125) 

WRITE (6,124) 


THE BEGINING OF THE MAJOR ITERATION LOOP. BEGIN THE LOOP IN 
GROUP KGST. 


1050 I TMA = I TMA* 1 
IT 0=0 

1060 I G=KGST 

I TM I GX = 0 
KF INSH=0 
K ASOR= 0 
EPGMP=EPGM 
EP GM=0. 0 
UPS1=0.0 
UP S2 = 0. 0 

IF IKONV-2) 1061.1070,1061 

1061 IF ( I TMA— 10 ) 1065, 1065,1070 
1065 TEMP=I IMA 

GO TO 1075 
1070 T EMP= 10 • 0 
1075 EPG=EPG/ T EMP 


ITERATIONS IN A NEW GROUP IG BEGIN HERE. BEGIN AT THE TOP OF THE 
REACTOR STARTING A Z DOWN AND UP PASS. 


1100 JUP=0 
IZ=NZ 
I TM I G=0 
KF ING( I G ) = 2 
SGI I G ) = 0 • 0 
IJG=INDEX(N1J, IG,0) 

DO 1105 IJ=1,NIJ 
1 JG = l J G* 1 

1105 XNN { 1 J ) = XN < IJG) 

IF (KSISU) 1150,1150.1110 

1110 IJG=INUEXINIJ, IG.O) 

DO 1115 Ij=1,NIJ 
I J G= I J G + 1 

1115 X JRN ( I J ) =X JR ( IJG) 

IF INZ-1) 1150,1150.1120 

1120 1JG= INDEX (NIJ. IG.O) 

DO 1125 I J = 1 ,N I J 
I JG= l JG*1 

1125 XJZN(IJ)=XJZ( IJG) 

C 
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C TO COMPUTE: THE ISOTROPIC FIXED SOURCE SISO WHICH INCLUDES THE 

C FISSION SOURCE AND THE ANISOTROPIC FIXED SOURCES ARSISO AND 

C AZSISG. ALL THE FIXED SOURCES INCLUDE UP AND DOWN SCATTERING 

C 0UT NO WITHIN GROUP SCATTERING. 

C 

1150 CALL FIXED ( XKE. MA . C. F* V, XN* XJR, XJZ, 

1 SG. S 1 SO* ARSISO* AZ SI SO ) 

C 

c 

C ITERATIONS FOR A NEW Z DOWN AND UP PASS IN A GIVEN GROUP IG 

C BEGIN FERE. 

C 

c 

1200 CALL INNER ( XKEll), 

1 HAIU.CIl), X 1 ( KDR ) , XI I KUZ) »X1( KMR) . X 1< KW) , Fill, 

2 xNosm.xNosupm.xNzsm , viii.ariii. 

3 AZ( 1 ) , OELZ ( 1 } , KF ING ( l) , KASQKG ( 1) ■ SG(1),ASG<1), 

* XNG( 1 ) »HNLG( 1 ) , VNLG1 1 ) .XNLGtl), 

5 CT ( 1 ) ,CGG1 1 ) ,CGGA( 1 ) ,T VLK1 1 ) , SI S0( II , ST ( 1 » , ARSI SOU ) , AZS ISOI 1 1 , 

6 ARST1 1), AZSim.OCI 1). XHKNI ) ,XH KNO) ,X2( KNOR) .X21KN0RUP), 

7 XNM ( l),X2(KNZ),X2( KNZR 1 • XNN<1).XNA<1J. X21KNR), 

8 XJRNl U.XJZNIll , XJR A 1 1 ) , XJZ A 1 1 1 , X2 1 KJRRI .X21KJZR1 , 

9 X2CKlaO).X21KWHITE), BUCLK(l) •BUCKGI1)* MXVARI ll),ESIJH(ll ) 
C 

c 

c 

1300 KF INSH=KF INSH+I AB S( KFiNG(IG)! 

IF (KSiSO) 1315,1315,1305 
1305 IF (KAS0RG1 IG) ) 1315,1315,1310 
1310 KAS0R=KAS0R+1 
1315 I TM1=I TM1*I TMIG 

IF (ITMIG-ITMIGX) 1325,1325,1320 
1320 ITM 1GX=I TMIG 

1325 IF ( EPGX-EPGM ) 1400,1400,1330 
1330 EPGM=EPGX 
C 

c 

C 70 COMPJTfc THE NEUTRON BALANCE PER GROUP. 

C 

c 

1400 IF (NBF-IJ 1415,1415,1405 
1405 BNLG1 I G ) -G , 0 

DO 1410 IJ-1.N1J 

1410 BNLGI I G 1 =BNLG( IG 1 ♦TVLKU J )*XNN l I J) 

XNLGC IG)=XNLG< IGl+BNLGl IG) 

1415 IF ( L BUCK ) 1425, 1425.1420 
1420 TEMP=6UCLK( 1G)*XNG(IG1 
XNLG1 1 G 1 =XNLG( IG ) ♦TEMP 
1425 IF (N8UCK1 1500,1500,1430 
1430 BNLGI 1G»=C.0 

DO 1435 IJ=1,NIJ 
K=1ABS(MA( IJ11 
K 1= INDEX 1 NG,K, IG) 

1435 BNLGI I G ) =8NLGi IG H-BUCKGI K1 ) *V< IJ)*XNN1IJ) 

XNLGll G)=XNLG1IG)*BNLG(IG) 
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1500 SING! IG)=SG( IG)-FG( IG) 

AG( l G 1 = 0 . 0 
FNG( IG ) =0. 0 
SCG( I G ) =C. 0 
S0G( 1GJ-0.0 

K1G=INDEX(NTYPS, IG.KCGG) 

K1A=INDEXINTYPS«IG» KCA ) 

DO 1535 1 J= 1 • N 1 J 
K = I ABS ( MA ( IJ) 1 
XNVl J=VI IJ )*XNN< I J I 
K2G= INDEX! NT YNG.K.K1G) 

K2A=IN0EXINTYNG»K,K1A) 

AG( IG)=AG( 1G)+C(K2A)*XNVI J 
FNGt 1G)=FNG< IG > +C ( K2A+1 J *XNVI J 
SCGI 1G)=SCGIIG)+C(K2G)*XNVIJ 
K1=IN0EX(NG,K, IG) 

1535 SDGI IG)=SDGI IG ) +CN2NI K1 )*XNVl J 
C 

1550 XNBi I G ) -I SGI IGI-XNLGI IGl-AGl I G)-SDG! I G) ) /XNF 


OVER-RELAXATION OF THE OUTER ITERATIONS. 


2000 IF I IABSIKACCEU-2) 2150.2005,2150 
2005 IF 4ITMA-1) 2 150, 2 150. 201 0 
2010 IF (KUPS) 2020, 2C20, 2015 

2015 IF I ABS I SCALUP— 1.0)-50.0*EPS) 2020,2020,2150 
2020 IF I EPGMP— 10.0*EPS) 2025,2025,2150 
2025 IJG=1NDEX(NIJ, IG.O) 

DU 2030 IJ=1,NIJ 

I JG=l JG+l 

XN A( I J J = XN ( IJG) 

20 30 XNN ( I J )=OMEGAP*XNNl I J J-OMEGPS* XNA ( I J ) 

C 

DO 2050 J=l.NZ 
I J= INOEX ( NR . J. NR ) 

T£MP=ORSCAL ( IJ, OHEGAP, OMEGPS, XNA, XNN I 
DO 2050 H= 1 ,ND 
K=INDEX (ND. J,M ) 

L= I NDEXI NDN2 , IG,K > 

XNOSIL l=XNOS(L)*TEMP 
IF (NZ-l) 2050.2050,2046 
2046 XNOSUP I L 1 =XNUSUP1 L ) *TEMP 
2050 CONTINUE 

IF (LZSAV) 2080,2080,2055 
2055 DU 2075 1=1, NR 

IJ*INDEX(NR.NZ. I ) 

TEMP=OKSC AL I IJ. OMEGAP, UMEGPS, XNA, XNN ) 
DO 2075 M=l .NO 
K= INDEXING, I , M ) 

L = INDEX( NDNR, IG.K ) 

2075 XNZS(L)=XNZSIL)*TEMP 
2080 IF IKSISO) 2150.2150,2085 
2085 DO 20V0 IJ=1.NIJ 
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XNA * XNN * 


I EMP=URSCAL ( I J, OMEGAP. OMEGPS, 

XJRN( I J )=XJRN( I J >*TEMP 
IF (NZ-i* 2090*2090*2089 

2089 XJZN(IJ*=XJZN(IJ)*TEMP 

2090 CONTINUE 

THE SUMMING TU OBTAIN THE UP SCATTERING ERROR. 

2150 IF (KUPSI 1800*1800*2155 

2155 IF (KREG* 2 157, 2 157* 2 156 

2156 IF (IG-NGI 2157*1800,1800 

2157 IF ( IG—KUPS ) 1800. 2 160,2160 
2160 IJG- INOEXC N I J, IG.O) 

00 2165 I J— 1 *N I J 
IJ G=I J G+ 1 
M=IA8S<MA( IJ** 

K= I NDEX ( NG* M, IG* 

T EMP=V ( IJ )*CUPS(K**IXNI IJG*-XNN(I J* J 
UPS 1-UPS 1+TEMP 
2165 UPS2=UPS2 + A8S< TEMP ) 

FINISHED WITH GROUP. 

1800 IJG=INDEXlNIJ*IG,0* 

DO 1805 I J-l *NI J 
I JG=I JG+1 

1805 XN( I JG)=XNN( IJ* 

IF ( KS I SO I 1900,1900*1810 
1810 IJG=INDEXiNlJ. IG.O) 

DO 1815 I 0* 1* N I J 
IJG=I JG+1 

1815 X JR ( 1 J G J =X JRN( IJ* 

IF (NZ-il 1900,1900,1820 
1820 IJG=INDEX(NI J.IG.O* 

DO 1825 IJ=1,NIJ 
I JG=I JG+ 1 

1825 X JZ ( IJG*=XJZN( IJ * 


GROUP INDEXING. 


1900 IF (KREG* 1901,1901*1925 

1901 I G= IG+ 1 

IF < KGST— 1 * 1905, 1905,1910 
1905 IF { I G-NG ) 1100*1100,2200 
1910 IF UG-KGST) 1 100, 2200, 191 5 
1915 IF (IG-NG) 1100,1100.1920 
192C IG= 1 

GO TO 1100 
1925 IG- IG— 1 

IF (KGST-NG* 1935*1930,1930 
1930 IF (IG) 2200*2200.1100 
1935 IF (IG-KGST* 1940* 2200 , HOC 
1940 IF (IG* 1945,1945,1100 
1945 IG-NG 
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GO TO U00 


SUMS OF GROUP QUANTITIES ARE COMPUTED ANO STORED IN THE NG + 1 
POSITION. 


2200 SING! NGP 1 I =0. 0 
SDG(NGPI)=0.0 
SCG ( NGP I J =0 • 0 

X NLG ( NGP 1 ) =0 • 0 
HNLGt NGP I ) =0. 0 
IE ( NZ— 1 ) 2202,2202,2201 

2201 VNL GC NGP 1 ) =0.0 

2202 IE (NBF-i) 2203 ,2203. 2204 

2203 IF (NBUCK) 2205 . 2 205 , 2204 

2204 BNLG(NGP1)=0.0 

2205 AG ( NGP 1 ) =0 . 0 
XNB( NGP 1 ) =0 .0 
XNGI NGP 1 ) =0 * 0 
00 2215 IG-l.NG 
XNG(NGP1)=XNG<NGP 1H-XNGUG) 
SING(NGP1)=SING(NGP i USING! IG) 
SDG(NGP1)=S0GCNGP IM-SOGI IG) 

SCG ( NGP 1 I=SCG<NGPi)+SCG( IG) 
XNLG(NGPl)=XNLG(NGPl) + XNLG 1 1 G ) 
HNLGI NGP 1 ) =HNLG ( NGP 1 ) +HNLG < I G ) 

IE i NZ— 1 1 2207,2207,2206 

2206 VNLG(NGPI) =VNLG( NGP i I+VNLG {IG ) 

2207 IE (NBE-n 22 08 , 2 208 . 2209 

2208 IE { NBUCK J 22 10 , 2 2 1 C, 2209 

220 9 BNLG(NGPl) =8NLGI NGPD+8NLGUG) 

2210 AG(NGPI) = AG(NGP1MAGIIG) 

2215 XNBINGP1)=XNB( NGP 1 ) +XNB ( I G ) 

CALCULATE UP SCATTERING SCALING. 

2225 IF (KUPS) 2300 . 23 00, 2226 

2226 SCALUP=EG(NGP1)/I FG ( NGP 1 > +UP S l ) 
IE ISCALUPI 2227,2227,2230 

2227 SCALUP- 1.0 
GO TO 2300 

2230 IE (KREG) 22 3 1 , 2 23 1 , 22 32 

2231 I TEMP=NG 
GO TO 2235 

2232 1 T EMP=NG— 1 

2235 DO 2285 I G =KUP S , I TE MP 
I JG=lNOEX ( N I J , IG, 0 ) 

DO 224 C IJ = 1,NIJ 
I JG=I JG+l 

2240 XNI IJG)=SCALUP*XN( I JG> 

DO 2245 J=l, NZ 
00 2245 M= 1 *ND 
K=INOEX(ND,J,M) 

L = I NDEX 1 NDNZ , IG,K > 

XNOSIL )=SCALUP*XNGS(L) 
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IF (NZ-1) 2245,2245,2243 
2243 XNOSUPt L ) =SCALUP*XN0SUPIL) 

2245 CONTINUE 

IF (LZSAV) 2260*2260,2250 
2250 DO 2255 1=1* NR 
CO 2255 M = I »NQ 
K=INDEX< ND, I * M ) 

L = INDEX! NDNR « IG,K) 

2255 XNZS<L)=SCALUP*XNZS(L> 

2260 IF (KS1S0) 2285*2285* 2265 
2265 IJ&=1NDEX(NIJ. IG* 0) 

DO 2270 IJ=1*NIJ 
UG = IJG + 1 

2270 XJRI IJG)=SCALUP*XJK< I JG) 

IF (NZ-U 2285.2285*2271 

2271 IJG=INDEX(NIJ.IG.Q) 

DO 2275 IJ=1*NIJ 
IJG=I JG+I 

2275 XJZII JG) = SCALUP*XJZU JG) 

2285 CONTINUE 

NEW LAMBDA QUANTITIES COMPUTED. 

2300 GLAM i = GL AM 

IF ( ABS(SCG(NGPU )-0. IE-6) 23 05 ,2 305 ,231 0 
2305 SDGFG 1= 1.0 
SCAT=1 . 0 
GO TO 2350 

2310 T EMP=SOG( NGP1 ) /FG ( NGP II 
SCAT=SDGFG1 /TEMP 
SDGFG1=T EMP 


TO COMPUTE THE NEW FISSION SOURCE. 


2350 EPG1=EPG 

CALL F 1 SION ( MA* V* C. FG* XKE » XN* XJR, XJZ, F, XNOS, XNOSUP, 
I XNZS ) 

IF (NEGSOR) 2375, 2375,2355 
2355 KEND=L 

WRITE 16,104) KEEN 

KEFN=2355 

KONV= 3 

GO TO 2500 


COMPUTE CONVERGENCE NUMBERS. 


2375 DI FQN£= 1 .0- GLAM 
TESTL=ABSIU IF ONE ) 
TEST2=RYF*ABS( 1.0- SCAT) 
TEST3=ABSI GLAM 1-GLAM) 

IF (KREG) 2377.2377.2376 

2376 TEST 4=0.0 



GO TO 2379 

237? IF (N2N) 23 78, 2378. 2376 

237 8 TEST 4=ABS ( I SING<NGP 1 )-SDG( NGP1 ) )/XNE ) 

2379 CALL TIMEUTIMEY) 

TIM EZ=ABS( ( TIME Y-TIMEX) )/3600.0 
IF (KALt-l) 2385.2380.2385 

2380 EIGEN=XKl(NGPl)/XKE(NGPl) 

GO TO 24 OC 

2385 IE { GLAM 1 ) 2390 , 2395 . 2390 
2390 EX TRP 1 = EX TRP 

EXTRP=( EICENP-E IGEN ) / IGLAMP-GL AM) 

TEST5=ABS( ( EXTRP i/EXTRP )-l . 0) 

2395 GO TO 2500 
C 

c 

C TEST CONVERGENCE NUMBERS* 

C 

c 

2400 IF (KFINSh) 240 1 . 240 1 . 241 5 

2401 IE (TEST1-EPS) 2405 . 2405. 241 5 
2405 IF ( TEST2— t PS ) 24 10, 24 10, 241 5 

2410 IF I T EST 3— EPS ) 24 1 1, 241 1 . 2415 

2411 IF (TEST 4- EPS) 24 12, 24 12 , 241 5 

2412 IE IKUPS) 2445,2445. 2413 

2413 IE ( ( UPS2/XNGINGP1) )-EPS> 2445 . 2445 ,241 5 
2415 IF ( ITMI-C ITMIMX+ITMIST) ) 2425 ,242 0 , 242 0 
2420 KON V= 1 

GO TO 2440 

2425 IE ( TIMEZ-T IMAX ) 2450, 2430 , 2430 
2430 KON V=— 1 
2440 I TM I ST= I TM I 
GO TO 2500 

2445 IF (KONV-2) 2446.2475,2446 

2446 IF (IT MA— 10 ) 244 7 , 2475 . 2475 

2447 KON V =2 

GO TO 2455 
C 

2450 K0NV=0 

2455 IE (ITMPRT) 1050.1050,2460 

2460 WRITE (6,121) I TMA , I TMI . I TM IGX , 1 TO , TI ME 2 , E PG 1 , E PGM , KASOR , KONV , 
1 KEINSH.XNBI NGP 1 ) , GLAM, EIGEN 

IE (NZ-1) 2466.2466,2467 

2466 TEMP=0*0 
GO TO 247C 

2467 TEMP=VNLG(NGP1) 

2470 WRITE (6,123) UP S2 . XNG( NGP 1 ) , S I NG ( NGP 1 ) , SDG( NGP1 ) , AG ( NGP l ) , 

1 HNLG(NCPl) , TEMP . XNLGI NGP1 ) 

WRITE (6,124) 

GO TO 105C 
C 

2475 KON V=2 
C 
C 
C 

2500 T IMEX=EPG1 
C 

255u IF (KENO) 2 5 /5 , 25 75 , 2560 
2560 KEEN=2 550 
2570 WRITE (6.1C4) KEEN 
C 

c 

c 

2575 KCHA IN* 3 
C 
C 

RETURN 

C 

ENO 
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* IBFTC ORSCAL CECK 

FUNCTION ORSCAL ( IJ, SCALE1, SCALE 2. XNA* XNN ) 

REACTOR ANALYSIS SECTION CLAYTON BARBER 

FEBRUARY 11, 1966 VERSION TN 

THE DIMENSION STATEMENTS 
DIMENSION XNAI1J, XNN(l) 


1000 TEMP=XNN(1J! +SC ALE2*XNA ( I J J 
IF (TEMP) 1005,1010,1005 
1005 GRSCAL=SCALE1*XNN( I J l/TEMP 
RETURN 

1010 ORSCAL= 1,0 
RETURN 


END 
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$1BFTC FISIGN DECK 

SUBROUTINE FISIGN I MA. V. C. FG. XKE. XN. XJR. XJZ. F, 
l XNOS. XNOSUP, XNZS I 


SUBROUTINE 


FISIUN FOR SUBROUTINES SETUP ANO OUTER OF TOSN 


TO COMPUTE THE FISSION NEUTRON SOURCE DENSITY FUJI. FISSION 

NEUTRON SOURCE GROUP SUMS FG(IG). ANO THE NEW LAMBDA. ALSO TO 
COMPUTE THE EFFECTIVE NEUTRON FISSION SPECTRUM CHI AND THE 
FISSION NEUTRON SOURCE GROUP SUMS USING THE NEW LAMBDA. TO 
NORMALIZE THE FISSION SOURCES ANO THE FLUXES TO A GIVEN 
NORMALIZATION FACTOR XNF SUCH THAT THE TOTAL FISSION SOURCE 
EQUALS XNF. ANO FINALLY TO COMPUTE THE INNER ITERATION EPSILON 
EPG. 


THE COMMON 

STATEMENTS 





COMMON 

/CALL!/ 

KCHAIN, 

KEND, 

KEFN 


COMMON 

/CALL2/ 

KBCRED, 




1 KKEG* 

KALC, 

KGEO, 

KBBC , 

KTBC, 

KLBC, 

2 KRBC • 



NSN, 

NG, 

NZ, 

3 NR* 

NTYPS* 

NMAT * 

LBUCK, 


KCTYP, 

4 KSISO. 

KGST. 

KCTR, 

KCGG, 

KDREAD, 

KFLUXIi 

5 


I TM I MX * 

I TMI GM, 

NZONER, 

NZONEZ i 

6 KACCEL. 

KALCi, 

NFN* 

N2N, 


ITMPRT, 

7 KBCDUP • 

KACAV. 

KGAVE , 

KNIP, 

KEOIT , 


8 


GLAM, 

EIGEN, 

EPS, 

XNF, 

9 RYF , 

TIMAX* 

CALC1, 


OMEGA, 

OMEGAP 

COMMON 

1 

/CALL 3/ 

HZ, 

HY, 

BF, 


2 

3 KONV * 

KF1NSH. 

KASOR, 

KUPS, 

KCA, 

KCF, 

4 NBF * 

NO. 

NGP 1 , 

NZPl , 

NRP1, 


5 NIJ, 

NTYNG* 

NONZ, 

NDNR • 

NDNIJ, 

NDNZNG 

6 NXNZS, 

NAR, 

NC, 

NI JG, 

NBUCK , 


7 UMA, 

I TMI ■ 

I TMI ST , 

I TMIGX, 

ITO, 


8 


NEGSOR, 


LZSAV, 


9 TIMEX, 

TIMEZ, 



SOGFG1, 

SCALUP 

COMMON 

/CALL4/ 

EPG, 

EPGX, 

EPGM, 

EPGMP, 

1 


OMEGAS, 

OMEGPS, 



2 

EXTRA I , 

EXTRA2, 

EXTRA3, 

EXTRA4, 

EXTRAS 

3 

KXTRA1, 

KXTRA2 , 

KXTRA3, 

KXTRA4 , 

KXTRA5 

THE OIMENSION STATEMENTS 




OIMENSION 

MA ( I ) • 

vm 

, 

cm 


OIMENSION 

FG( I), 

XKE t 

n , 

XNIII , 


l 

XJR t II * 

XJZt 

n 



OIMENSION 

Ft n. 

XNOS ( 1 I , 

XNOSUPt 1) 

, 

I 

XNZSt I) 
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C THE FORMAT STATEMENTS 

100 FORMAT (2 5h TOTAL SOURCE FGINGPl) OF, E16.8, 24H IS ZERO OR NEGATI 
1VE • ) 

THE INTEGER FUNCTIONS 

INDEX! LENGTH. I NDE XQ. I NDEXL ) -LENGTH* ( I NDE XQ-1 I ♦ INDEXL 


1000 FTP=FG( NGP 1 1 
NEGSOR^O 

TO COMPUTE THE FISSION NEUTRON SOURCE DENSITY AND ITS VOLUME 
INTEGRAL BY GROUPS. 

1010 DO 1015 I J S 1 «N I J 
1015 F ( IJ )=0.0 

DO 1040 I G= l • NG 
IJG=INDEX(NIJ» IG.O) 

IF (KREG) 1020. 1C20. 1030 
1020 DO 1025 IJ=1*NIJ 
IJG=i JG+1 
K=IABS(MA( IJ)) 

K 1= INDEX! NT YPS.IG.KCF) 

K2= INDEX! NT YNG. K. K 1) 

1025 FI I J ) = F ! IJ)+C(K2)*XN(IJG) 

GO TO 1040 

1030 DO 1035 IJ=1,NIJ 
IJG=IJG*1 

1035 F ! I J ) = F ! I J ) ♦XKE !IG)*XN(IJG) 

1040 CONTINUE 

FGI NGP 1 ) =0.C 
IF (KREG) 1060* 1060* 1045 
1045 DO 1055 IG= 1 *NG 
FG( IG ) =0.0 

K 1= INDEXINTYPS. IG, KCF } 

00 1050 1 J=1.N I J 
K= I ABS( MA ( 1 J i ) 

K2=INDEX! NTYNG.K.K1) 

1050 FG! !G)=FG( IG)+C(K2)*F( I J 1*V( I J) 

1055 FG!NGP1)=FG(NGP1)+FG( IG) 

GO TO 107C 

1060 TEMP=0.0 

DO 1061 IJ=1,NIJ 

1061 TEMP=T EMP + V! I J ) *F I IJ) 

DO 1065 I G = 1* NG 

FG! IG)=TEMP*XKE! IG) 

1065 FG! NGP 1 ) =FG (NGP 1)+FG(IG) 

1070 IF (KALC) 1100.1100,1075 
1075 IF (FG(NGPl)) 1080 . 1080. i 100 
1080 WRITE 16,100) FG(NGPi) 

NEGSOR^l 

TO CALCULATE THE NEW LAMBDA. 
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1100 IF INFN-1) 1105,1150.1105 
1105 GLAM=FG(NGP1)/FIP 

TC NORMALIZE THE FISSION SOURCES AND THE FLUXES TO A GIVEN INPUT 
NORMALIZATION FACTOR XNF SUCH THAT THE TOTAL FISSION NEUTRON 
SOURCE WILL EQUAL XNF FOR THE PROBLEM SETUP AND TO NORMALIZE 
FOR THE GROWTH FACTOR LAMBDA (GLAM) AFTER EACH POWER ITERATION. 

125 IF IKALC-1) 1150.1130,1150 
130 TEMP=1. O/GLAM 

DO 1135 IG*1,NGP1 
XKEI IG)=TEMP*XKE( IG) 

1135 FG( I G ) =T EMP + FG 1 IG) 

IF (KREG) 1175,11/5, 1 140 
1140 DO 1145 I J = 1 , N I J 
145 F ( IJ ) = T EMP* F ( IJ ) 

GO TO 1175 

150 NFN=0 

EIGEN^l.O 

IF (KALC) 1155,1155,1175 
155 CONTINUE 
GO TO 1350 

175 IF 1 XNF ) 1350,1350,1180 

180 T EMP = XNF/FGI NGP 1 ) 

IF (ABSITEMP— l.0)—0. IE— 9) 1350,1350,1200 
1200 DO 1205 I G= l, NGP 1 
1205 FGI IG)*TtMP*FG( IG) 

DO 1210 IJ=i,NIJ 
1210 fi I J )*T EMP*FI IJ) 


1225 DO 1250 IJG=1,NIJG 
1250 XNI IJG)*TEMP*XN( IJG) 

00 1255 L = 1 , NDNZNG 
1255 XNOS(L)-TEMP*XNQS(L) 

IF INZ-l) 1280, 1280, 1270 

1270 DO 1271 L~ 1, NON ZNG 

1271 XNOSUPIL) =TEMP* XNO SUP ( L ) 
DO 1275 L= 1 »NXNZ S 

1275 XNZS(L)=TEMP*XNZS(L> 

1280 IF (KSISO) 1350,1350,1285 
1285 DO 1295 IJG^l.NIJG 

X JR ( I JG)=TEMP*X JR ( IJG) 

IF (NZ-1) 1295, 1295, 1290 
1290 XJZ( IJG)=TEMP*XJZ( IJG) 
1295 CONTINUE 


TO COMPUTE THE EPSILON EPG FOR THE INNER ITERATIONS. 


1350 TEMP=NG+3 

TEMP=40.0*EPS/TEMP 
FPG=TEMP*FGINGP 1) 


1400 RETURN 
C 

END 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


BFTC FIXED DECK 

SUBROUTINE FIXED ( XKE « MA » C, F, V, 
1 SO, SI SO. ARSISO, AZSISO ) 


XN, XJR, XJZ, 


C 

C 


c 

c 

c 

c 

c 


SUBROUTINE FIXED COMPUTES THAT PORTION GF THE SOURCE THAT REMAINS 
FIXEO WITHIN THE GROUP UNNER) ITERATIONS. 


THE COMMON 

STATEMENTS 





COMMON 

/CALL 1/ 

KCHAiN. 

KEND, 

KEEN 


COMMON 

/CALL2/ 

K3CRED . 




1 

KREG. 

KALC. 

KGEO. 

KB6C • 

KTBC, 

KLBC, 

2 

KRBC. 



NSN, 

NG, 

NZ, 

3 

NR. 

NTYPS. 

NMAT. 

LBUCK, 


KCTYP, 

4 

KSiSO. 

KGST. 

KCTR. 

KCGG , 

KDREAD . 

KFLUX I < 

5 



ITMIMX. 

ITMIGM, 

NZONER, 

NZONEZi 

6 

KACCEL. 

KALC 1 • 

NFN » 

N2N. 


ITMPRT 

7 

KBCDUP. 

KACAV. 

KGAVE « 

KNIP, 

KEDIT, 


8 



GLAM, 

EIGEN, 

EPS, 

XNF, 

9 

RYF, 

TIMAX. 

CALCI, 


OMEGA, 

OMEGAP 

COMMON 

/CALL 3/ 





1 



HZ. 

HY. 

BF, 


2 





KC A, 

KCF, 

3 

KONV. 

KFINSH, 

KASOR, 

KUPS. 



4 

NBF, 

NO. 

NGPi, 

NZP1, 

NRPI , 


5 

NIJ. 

NTYNG. 

NONZ. 

NDNR, 

NDNIJ, 

NDNZNG 

6 

NXNZS. 

NAK, 

NC. 

NI JG. 

NtiUCK * 


7 

ITMA* 

ITMI. 

ITMIST, 

ITMIGX, 

ITD, 


8 



NEGSOR, 


LZSAV, 


9 

TIMEX. 

TIMEZ. 



SOGFG1, 

SCALUP 

COMMON 

/CALL4/ 

EPG, 

EPGX, 

EPGM* 

EPGMP, 

L 



OMEGAS, 

OMEGPS, 



2 


EXTRA 1 . 

EXTRA2, 

EXTRA3, 

EXTRA4, 

EXTRAS 

3 


KXTRAI. 

KXTRA2, 

KXTRA3, 

KXTRA4, 

KXTRA5 

COMMON 

/C INNER/ 

ITMIG, 

IG, 

IZ, 

JUP, 

1 

XITGG. 

X1TGGA. 

LG, 

NEGPRT • 

JZ, 

KX 


THE DIMENSION STATEMENTS 


DIMENSION 

DIMENSION 

DIMENSION 

DIMENSION 

DIMENSION 

DIMENSION 

DIMENSION 


XKE i II 
MAID. 
Fill 
VI II 
XN ( II* 
SGI I) 

si sum. 


cm 

XJRU) • 
ARSISO(l) . 


xjzm 

Azsisom 


THE INTEGER FUNCTIONS 

INDEX! LENGTH. INDEXQ* INUEXLI =LENGTH* ( I NDEXO-1 ) +INDEXL 
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r> r- 


1000 IF ( KRfcG) 1140,1140,1130 
1130 K1=1NDEXINTYPS»IG»KCF) 

00 1135 I J = 1 ,N l J 
K = 1 A6S ( MA ( 1J ) 1 
K2=1NDEX( NTYNG.K.Kl) 

1135 S ISO! I J >=C< K2)*F( IJJ 
GU TO 1150 

1140 DO 1145 1J=1,NIJ 
1145 SISO! IJ)=XKE( 1G1*F(IJ) 

C 

1150 IF (KSISO) 1155,1155,1151 

1151 DO 1152 IJ=1,NIJ 

1152 ARS ISO! IJ)=0.0 

IF ( NZ- 1) 1155,1155,1153 

1153 DO 1154 I J = l.N I J 

1154 AZSISO! IJ)=0.0 
C 

UP SCATTERING 

1155 K gCUP^nCGG- IKC Tkt 1 ) 

N= 1 G 

I T Y=KCGG 

IF IKSCUP1 1250,1250.1160 

1160 IF (KREG) 1161,1161,1163 

1161 IF ( I IG+1J-KUPS) 1250,11161,11161 
11161 IF (IG-NG) 1162,1250,1250 

1162 N=N+ 1 

GO TO 1170 

1163 IF 1IG-KUPS) 1250, 1250,1164 

1164 N=N- 1 

1170 ITY=ITY-1 

IF (KREG) 1171,1171,1172 

1171 K1=INDEX(NTYPS,IG,ITY) 

GO TO 1175 

1172 K1=INDEX(NTYPS,N,1TY) 

1175 IJG=INDEX(NIJ,N,0) 

DO 1200 I J-= 1 , N I J 

1 JG=I JG+1 

K= I ABS I MA ( I J ) ) 

K A=K 

IF (KSISO) 11B0, 1 1B0. 1176 

1176 IF (HAIIJIl 1177,1180,1180 

1177 KA=K+ 1 

1180 K2=INDEXt NTYNG.K.Kl) 

IF ICIK2)) 1185,1190,1185 
1185 SISOI lJ)=SISO( IJ)+C(K2)*XN( IJGI 

1190 IF (KSISO) 1200,1200, 1191 

1191 IF (KA-K) 1200, 1200, 1192 

1192 K2=INDEXINTYNG,KA,Kl) 

IF ( C I K 2 ) ) 1195.1200, 1195 

1195 ARS I SO I IJ)=ARSIS0(IJ)*C(K2)*XJR(IJG) 
IF (NZ-1) 1200, 120C, 1196 

1196 AZSISOI I J ) =AZS I SO I I J ) *C ( K2 ) *X JZ (I JG ) 
1200 CONTINUE 

IF I KREG ) 1205,1205,1215 
1205 IF (N-NG) 1210. 1250, 1250 


non non n ono 


1210 IF UKCGG-ITYJ-KSCUP) 1 162 . 12 50 . 1250 

1215 IF (N-KUPS) 1250, 1250,1220 

1220 IF UKCGG-ITYJ-KSCUP) 1 1 64 ,125C, 1250 

GOWN SCATTERING 

1250 IF IKREG) 1251, 1251. 1252 

1251 N=0 

I T Y=KCGG+ IG 

IF IIG-l) 1350, 135C. 1260 

1252 N-NGP 1 
ITY=KCGGUNGP i-IGI 

IF UG-NGJ 1260,1350,1350 

1260 ITY=ITY— 1 

IF IKREG) 1265,1265,1270 

1265 N=N+ 1 

IF INTYPS-ITY) 1260,1266,1266 

1266 K1=INDEXINTYPS. IG.ITY) 

GO TO 1280 

1270 N=N— 1 

IF (NTYPS-ITYJ 1260,1275,1275 
1275 Kl= INDEX! NT YPS, N, I TY 1 
1280 IJG=INDEX<N1J,N,0) 

DO 1325 IJ=1,NIJ 

IJG=IJG+1 

K=1 ABSi MAI 1 J J ) 

KA=K 

IF IKSIS01 1290,1290,1286 

1286 IF I HA ( I J 1 J 1267, 1290,1290 

1287 KA=K+1 

129C K2= INDEX! NT YNG, K,K1J 

IF (CIK2JI 1295.1300,1295 
1295 SISOC I J ) =SI SO! IJI+C!K2)*XN<UG) 

1300 IF (KSISG) 1325,1325,1305 
1305 IF (KA-KI 1325,1325,1310 
1310 K2= INDEXI NTYNG,KA, Kl) 

IF ICIK21I 1315.1325,1315 
1315 ARS ISO ( IJ)=ARSIS0(1JUC!K2)*XJR!I JG1 
IF (NZ-1) 1325.1325.1320 
1320 AZSISOI I J )*AZSI SOI I J J+CIK2 J*X JZU JGI 
1325 CONTINUE 

IF IKREG) 1330.1330.1335 
1330 IF !N-<1G-1)J 1260.1350,1350 
1335 IF I N — C 1G+ l J ) 1350. 1350,1260 

FINISH FIXED SOURCE 

1350 DO 1355 IJ=1,NIJ 

SISOi IJ)=S1S0C IJ)*V! IJI 
1355 SG ! i G ) s SG I IGI+SISG! I J 1 

IF IKSISOI 1400,1400,1360 
1360 DO 1365 IJ=1.N1J 
1365 ARS I SOI I J J - ARS ISO! I«Ji*V!IJ) 

IF INZ-ll 1400.1400,1370 
1370 DO 1375 IJ*1,NIJ 
1375 AZSISOI IJ)=AZSISOC IJ)*VUJ) 


1400 RETURN 
C 

END 
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IBFTC INNER DECK 

SUBROUTINE INNER 

1 XNOS > XNOSUP 9 

2 V 9 AR 9 AZ 9 DELZ 9 

3 VNLG*XNLG » 

4 AZST * DC * XN 

5 XNR.XJRN.XJZN 

6 BUCLK.BUCKG, 


( XKE, MA, C 

XNZS ♦ 

KFING.KASORG. 
CT.CGG.CGGA.TVLK.S 
I »XNO»XNOR»XNORUP »XNM 
» X JRA 9 XJZA 9 XJRR 9 XJZR 9 
MXVARI ,ESI JM 


9 DR 9 DZ * MR 9 W t Ft 

SG 9 ASG 9 XNG 9 HNLG 9 

ISO 9 ST 9 ARSISO 9 AZSISO 9 ARST 9 
9 XNZ 9 XNZR 9 XNN9XNA, 

XNM180 9 WHI TE 9 

) 


SUBROUTINE INNER PREFORMS 
GIVEN GROUP IG. 


THE INNER (OR MINOR) 


ITERATIONS IN A 


THE COMMON 

STATEMENTS 





COMMON 

/CALL 1 / 

KCHAIN, 

KEND, 

KEFN 


COMMON 

/CALL 2 / 

kbcred. 




1 KREG* 

KALC, 

kgeo. 

KBBC , 

KTBC , 

KLBC , 

2 KRBC * 



NSN , 

NG, 

NZ, 

3 NR, 

NTYPS, 

NMAT , 

LBUCK , 


KCTYP, 

4 KSISO, 

KGST, 

KCTR, 

KCGG , 

KDREAD , 

KFLUXI , 

5 


ITMIMX, 

ITMIGM* 

NZONER, 

NZONEZ, 

6 KACCEL, 

KALC1, 

NFN, 

N 2 N , 


ITMPRT, 

7 KBCDUP, 

KACAV, 

KGAVE, 

KNIP, 

KEDIT, 


8 


GLAM, 

EIGEN, 

EPS, 

XNF , 

9 RYF , 

timax. 

CALC1, 


OMEGA, 

OMEGAP 

COMMON 

1 

/CALL3/ 

HZ, 

HY, 

BF, 


2 

3 ’ KONV , 

KFINSH, 

KASOR, 

KUPS, 

KC A , 

KCF, 

4 NBF , 

ND, 

NGP1, 

NZP 1 , 

NR P 1 , 


5 NIJ, 

NTYNG, 

NDNZ , 

NDNR , 

NDN I J , 

NDNZNG, 

6 NXNZS, 

NAR, 

NC, 

NI JG, 

NBUCK , 


7 I TMA * 

ITMI , 

ITMIST, 

ITMIGX, 

ITD, 


8 


NEGSOR, 


LZSAV, 


9 TIMEX, 

timez. 



SDGFG1 , 

SCALUP 

COMMON 

/CALL4/ 

epg, 

EPGX , 

EPGM , 

EPGMP , 

1 


OMEGAS, 

OMEGPS, 



2 

EXTRA1, 

EXTRA2, 

EXTRA3, 

EXTRA4, 

EXTRAS, 

3 

KXTRA1, 

KXTRA2 , 

KXTRA3, 

KXTRA4, 

KXTRA5 

COMMON 

/CINNER/ 

ITMIG, 

IG, 

IZ , 

JUP, 

1 XITGG, 

XITGGA, 

LG, 

NEGPRT, 

JZ, 

KX 

THE DIMENS 

ION STATEMENTS 




DIMENSION 

XKE(l) 





DIMENSION 

MA { 1 ) , 

C ( 1 ) 




DIMENSION 

DR ( 1 ) , 

DZ( 1 

) , 

MR ( 1 ) , 


1 

W(1 ) 





DIMENSION 

F ( 1 ) 





DIMENSION 

XNOSU ) , 

XNOSUP ( 1 ) , 

XNZS(1 ) 


DIMENSION 

V(1 ) ♦ 

AR ( 1 ) 9 

AZ ( 1 ) , 


1 

DELZ(l) 





DIMENSION 

KFINGU ) , 

KASORGt 1 ) 



DIMENSION 

SG ( 1 ) , 

ASG ( 

1 ) , 



1 


XNG ( 

1 ) , 

HNLG ( 1 ) , 


2 

VNLG(l) , 

XNLG 

( 1 ) 
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DIMENSION 

CT< 1 ) , 

C GG 1 1 ) * 

CGGAtl) * 

1 

TVLK(l) , 

SISO(l)* 

ST ( 1 ) * 

2 

ARSISOI 1) , 

AZSISO ( 1 ) ♦ 

ARST(I) » 

3 

AZSTd ) , 

DC ( 1 ) 


DIMENSION 

XNI ( 1) , 

XNO ( 1 ) * 

XN0R(1I t 

1 

XNORUP(l), 

XNM ( 1 ) t 

XNZ ( 1 ) ♦ 

2 

XNZR(l) 



DIMENSION 

XNN ( 1 ) , 

XNA ( 1 ) • 

XNR(l) » 

1 

XJRN ( 1 ) , 

XJZN (lit 

XJRA(l) , 

2 

XJZA(l), 

X JRR { 1 ) • 

XJZR(l) 

DIMENSION 

XNM180I1), 

WHITE ( 1 ) , 

BUCLK(l) 

1 

BUCKG(l) , 

MXVARI (1) ♦ 

ESIJM(l) 


THE FORMAT STATEMENTS 

150 FORMAT (IX, 6HSCALE=,F10.6»8H FOR IG=,13,11H AND 1TMIG=,I3, 
1 19H AND WAS SET TO 1.0 ) 

200 FORMAT <2I10,5X,5E17.7> 

THE INTEGER FUNCTIONS 

INDEX (LENGTH, I NDEXO , I NDEXL ) =LENGTH* < INDEXO-1 ) +INDEXL 


ITERATIONS FOR A NEW Z DOWN AND UP PASS IN A GIVEN GROUP IG 
BEGIN HERE. 


990 NEGPRT=0 

1000 ITMIG=ITMIG+1 
I TD= I TD+1 

TO INITALIZE THE NEW FLUX AND CURRENTS TO ZERO FOR THE DOWN AND 
UP PASS. 

1025 DO 1050 I J=1 » N I J 
XNA ( I J ) =XNN ( I J) 

1050 XNN ( I J ) =0 .0 

IF (KSISO) 1100,1100,1060 
1060 DO 1065 I J=1 »NI J 
XJRAI I J)=XJRN( IJ ) 

1065 XJRN ( I J ) =0.0 

IF (NZ-1) 1100,1100,1070 
1070 DO 1075 I J=1 ,N I J 
XJZA(IJ)=XJZN(IJ) 

1075 XJZN ( I J ) =0.0 

ITITALIZATIONS FOR THE TOP BOUNDARY AND THE INITIALIZATION TO 

ZERO OF SUMS PREFORMED DURING A DOWN AND UP PASS ARE DONE HERE. 

1100 ESC=0.0 

ESI JM( I G ) =0. 0 
ESM=0.0 
EAM=0.0 
XNG ( IG ) =0. 0 

IF (KSISO) 1102,1102,1101 

1101 ASG ( IG ) =0.0 

1102 X I TGG=0 .0 
X I T GGA = 0. 

LG=0 
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hnlgr=o.c 
HNLGL = 0.0 
HNLG ( IG> =0.0 

IF ( NZ— 1 ) 1105,1105.1110 

1105 xnzs( 1 )=o.c 

XNZ ( 1 ) =0. 

GO TO 1200 

1110 VNLG ( I G ) =0 .0 
DO 1111 M=1,ND 

1111 DZ ( M ) =— DZ ( M ) 

IF ( KTBC ) 1115,1115,1125 

1115 DO 1120 1=1, NP 
DO 1120 M=1,ND 
K = l NDEX ( ND , I ,M) 

1120 XNZ ( K ) =0 . 

GO TO 12C0 
1125 DO 1130 1=1, NR 
DO 1130 M= 1 » ND 
K= I NDEX ( ND , I , V ) 

K1=INDEX(NDNR.IG«K) 

1130 XNZ (K> =XNZS MCI ) 

C TO COMPUTE THE VERTICAL TOP BOUNDARY NEUTRON LEAKAGE FOR BEFORE 

C THE Z DOWN AND U° PASS. 

C 

1 15C IF (K.TBC-3) 1185,1155,1 185 

1155 DO 1180 1=1 , NR 
TEMP=0.0 
TEMP1=0.0 
DO 1160 M=1,ND 
K = I NDEX ( ND , I , M ) 

TEMP=TEMP-W(M)*DZ(M)*XNZ (K) 

1160 TEMP1 = TEMP 1-W (M ) *DZ (M ) 

TEMP1=TEMP/TEMP1 
DO 1165 M=1 *ND 
K= I NDEX t ND , I , M ) 

1165 XNZ (K)=TEMP1 
1180 CONTINUE 
C 

1185 DO 1195 1=1, NR 
tlg=o . o 

DO 1190 M= 1 , ND 
K = I NDEX ( ND , I ,M ) 

1190 TLG=TLG+W(M>»D7(M)*XNZ(K> 

1195 VNLG ( I G ) = VNLG ( IG>+TLG*AZ ( I ) 


ITERATIONS IN A NEW Z INTERVAL IZ IN A GIVEN Z DOWN AND UP PASS 
AND A GIVEN GROUP IG BEGIN HERE. 


1200 IF (LG) 1300,1300,1305 


TO COMPUTE THE TOTAL CROSS SECTION LOSS AND STORE THE WITHIN GROUP 
SCATTERING CROSS SECTION BY MESH INTERVALS AND TO STORE 

effective buckling cross sections if used. 
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1300 KX = 0 

GO TO 1310 
1305 KX= 1 
1310 JZ=IZ 

CALL SORAXS ( MA, V, C. CT, CGG, 

1 CGGA, TVLK, BUCLK, BUCKG ) 

IF (LG) 1325*1325 ,1400 

TO COMPUTE THE TOTAL BASIC SOURCE BY ADDING THE SELF-SCATTERING 
SOURCE TO THE FIXED SOURCE FOR THE GIVEN Z MESH INTERVAL IZ. 

1325 DO 1326 I=1*NR 

I J= I NDEX ( NR * I Z * I ) 

1326 ST ( I )=SISO< I Jl+CGGI I ) *XNA ( I J ) 

IF (KSISO) 1400,1400,1350 

1350 KASORG ( I G ) =0 

DO 1385 I =i *NR 
TEMP = 3.0*ST( I ) 

I J= I NDEX ( NR * I Z * I ) 

ARST ( I ) =ARSI SO ( I J ) +CGGA < I )*X JRA( I J) 

IF C TEMP-ABS ( ARST ( I } ) ) 1355.1360.1360 
1355 KASORGI IG)=KASORG I IG)+1 

ARST ( I ) =S IGN( TEMP, ARST ( I I ) 

1360 IF (NZ-1) 1370,1370,1361 

1361 AZSTI I ) =AZSI SO ( I J ) +CGGA ( I ) *X JZ A ( I J ) 

IF (TEMP-ABSIAZST ( I ) ) ) 1365.1370,1370 

1365 KASORGI I G ) =K ASORG < IGl+l 

AZSTI I )=SIGN( TEMP, AZSTI I ) ) 

1370 IF (JUP) 1375.1375,1385 
1375 ASGI IG)=ASGt IG)+ARSISD( IJ) 

IF (NZ-1) 1385,1385,1380 
1380 ASGI IG)=ASG( IG)+AZSISO( IJ) 

1385 CONTINUE 


TO COMPUTE THE ANGULAR FLUX FOR ND DIRECTIONS (IN EACH HALF OF A 
Z DOWN AND UP PASS FOR A TOTAL OF 2*ND DIRECTIONS) BY RADIAL 
MESH INTERVALS AND TO SUM IN ORDER TO OBTAIN THE NEW AVERAGED 
FLUXES XNN. 


XLLG=0 . 0 

CALL FLUX I AR( 1 ) ,AZ(1 ) ,DELZ( 1 ) ,DR 1 1 ) ,DZ 1 1 ) ,MR I 1 ) ,K( 1 ) , 

1 CT(l),ST(l),ARSTtl) ,AZST 1 1 ) ,DC I 1 ) , XN III) ,XN0(1),XNQS(1), 

2 XNOSUP I 1 ) , XNM I 1 ) , XNZ 1 1 ) , XNN 1 1 ) , X JRN I 1 ) , X JZN 1 1 ) , 

3 XNM 180(1) , WH I T E 1 1 ) , XLLG ) 


TO COMPUTE THE HORIZONTAL NEUTRON LEAKAGES. 


1450 RLG=0.0 

DO 1455 M = 1 , ND 

1455 RLG=RLG+W(M)*DR(M)»XNO(M) 
RLG=RLG*AR(NRP1)*DELZ( IZ) 
HNLGR=HNLGR+RLG 

GO TO (1456,1460.1460), KGEO 

1456 IF I KLBC ) 1457,1457,1460 

1457 XLLG = XLLG*AR I 1 )*DELZ I IZ ) 
HNLGL=HNLGL+XLLG 
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C TO store the radial boundary angular fluxes. 

c 

1460 DO 1465 M=1.ND 
K=INDEX(ND,IZ,M) 

L= I NDEX ( NDNZ . IG,K) 

IF UUP) 1461.1461,1462 

1461 XN0S(L)=XN0(M) 

GO TO 1465 

1462 XNOSUP < L ) =XN0 < M) 

1465 CONTINUE 


TO CONTROL THE Z DOWN AND UP PASS. 


1470 IF ( NZ-1 ) 1600, 16C0, 1475 

1475 IF (JUP) 1480,1480*1440 
1480 IF (IZ-1) 1500,1500,1485 

1485 I Z= I Z- 1 

IF (LG) 1300,1300.1305 
1490 IF (IZ-NZ) 1495,1540,1540 
1495 IZ=IZ+1 

IF (LG) 1300,1300,1305 


TO COMPUTE THE VERICAL BOTTOM BOUNDARY NEUTRON LEAKAGES. 


1500 BLG = 0 , C 

IF ( KBBC ) 1505,1505,1525 

1505 DO 1515 1=1, NR 
TEMP=C . 0 
DO 1510 M = 1 , ND 
K= I NDEX ( ND , I ,M) 

1510 TEMP=TEMP-W(M)*DZ (M)*XNZ (K) 

1515 BLG = BLG+TEMP*AZ( I ) 

DO 1520 1=1, NR 
DO 1520 M=1 ,ND 
K=I NDEX (ND, I , M ) 

1520 XNZ ( K ) =0. 

RE-STORE THE OUTWARD DIRFCTED ANGULAR FLUXES AT THE BOTTOM 

BOUNDARY TO BE UPWARD DIRECTED FLUXES AFTER UNDER GOING 180 
DEGREE ROTATION AND REFLECTION ABOUT THE FIRST DIRECTION 
MID-POINT. 

1525 IF ( KBBC-4 ) 1538,1526,1538 

1526 ITEMP2=M0D(NR,2) 

I TEMPl=NR/2 

IF (ITEMP2) 1528,1528,1527 

1527 I TEMP 1 = I TEMP 1 + 1 

1528 K=0 

I TEMP = NRP 1 
DO 1537 1 = 1 , 1 TEMP 1 
ITEMP=ITEMP-1 
K 1 =K 

DO 1529 M= 1 , ND 
K 1 =K1+ 1 

1529 XNO ( M ) =XNZ ( K 1 ) 

MM = 0 

DO 1532 M = 1 , ND 
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K = K+1 

IF ( ABSIW(M) J-0.1E-09) 1 530 , 1 53 0 » I 53 1 

1530 MM=MM+1 

L = I NDEX < NR »MM « I TEMP ) 

XNZ (K)=XNM180<L> 

GO TO 1532 

1531 M1=MR(M) 
ki=index<nd,itemp.mi) 

XNZ(K)=XNZ(K1) 

1532 CONTINUE 

IF (I-lTEMPl) 1533,11532,1537 
11532 IF ( ITEMP2 ) 1533,1533,1537 

1533 MM=0 

K2=INDEX(ND,ITEMP,0) 

DO 1536 M= 1 » ND 
K2=K2+1 

IF (ABS(WIM) )-0,lE-09) 1 534* 1 534 , 1 535 

1534 MM=MM+1 
L=INDEX<NR,MM,I ) 

XNZ(K2)=XNM180(L> 

GO TO 1536 

1535 Ml=MR(M> 

XNZIK2)=XN0<M1 ) 

1536 CONTINUE 

1537 CONTINUE 

SET PARAMETERS TO GO FROM BOTTOM TO TOP THROUGH THE MESH. 

1538 JUP=1 
IZ=1 

DO 1539 M= 1 , ND 

1539 DZ(M)=-DZ(M) 

IF (LG) 1300,1300,1305 


TO COMPUTE THE VERICAL TOP BOUNDARY NEUTRON LEAKAGE FOR AFTER 
THE Z DOWN AND UP PASS. 


1540 TLG=0 . 0 

DO 1550 1=1, NR 
TEMP=0 . 0 
DO 1545 M=1 , ND 
K= I NDEX ( ND , I ,M ) 

1545 TEMP = TEMP+W (M)*DZ(M)*XNZ(K) 

1550 TLG = TLG+TEMP*AZ( I ) 

VNLG ( I G I =VNLG ( IGJ+TLG 

TO STORE THE TOP BOUNDARY ANGULAR FLUXES. 

IF (LZSAV) 1600,1600,1560 
1560 DO 1565 1=1, NR 
DO 1565 M=1 , ND 
K= I NDEX ( ND , I ,M) 

L=I NDEX ( NDNR , IG, K ) 

1565 XNZS ( L ) =XNZ ( K ) 


1600 IF (LG) 1610,1610,1650 
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TO CHECK FOR THE NECESSITY OF MAKING A NET LEAKAGE 

CORRECTION PASS AND TO SAVE CERTAIN PARAMETERS WHEN THIS IS 
REQUIRED. 


1610 RAHLK=0.0 
HLK = 0. 0 

IF (KRBC-l) 1613,1611,1611 

1611 TEMP=0 . 0 

DO 1612 J=1,N2 
I J=INDEX(NR,J,NR> 

1612 TEMP=TEMP+XNN( I J ) 

TEMP = ABS< TEMP) 

HLK=ABS(HNLGR) 

IF (TEMP) 11612,1613,11612 
11612 RAHLK=HLK/TEMP 

1613 IF ( NZ - 1 ) 1618,1618,1614 

1614 IF ( KTBC-1 ) 1618,1615,1615 

1615 T EMP= 0.0 

DO 1616 1=1, NR 
I J= I NDEX ( NR ,NZ , I ) 

1616 TEMP=TEMP+XNN( I J) 

IF (TEMP) 11616,1617,11616 
11616 R AVLK = ABS (VNLGI IGl/TEMP) 

IF (RAVLK-(EPG/10.0) ) 1617,1617,1620 

1617 IF (ABStVNLGt IG) )-(EPG/10.0) ) 1618,1618,1620 

1618 IF ( RAHLK- ( EPG/10 .0 ) ) 1619,1619,1620 

1619 IF ( HLK - (EPG/lO.O)) 1700,1700,1620 

1620 IF (ITMIG-1) 1700,1700,11619 

11619 IF (EPGX-0.1) 11620,11620,1700 

11620 LG= 1 

DO 1623 I J= 1 , N I J 
XNR ( I J ) =XNN ( I J) 

XNN ( IJ)=0.0 

IF (KSISO) 1623,1623,1621 

1621 XJRRf I J)=XJRN( I J) 

XJRN ( I J ) =0.0 

IF (N2-1) 1623,1623,1622 

1622 XJZRt I J)=XJZN( I J) 

XJZNI IJ)=0.0 

1623 CONTINUE 

DO 1625 J= 1 * NZ 
DO 1625 M= 1 , ND 
K= I NDEX ( ND , J , M ) 

L=INDEX<NDNZ,IG,K) 

XNOR(K)=XNOS(L) 

IF ( NZ-1 ) 1625,1625,1624 

1624 XNORUP ( K ) =XNOSUP ( L ) 

1625 CONTINUE 

IF (LZSAV) 1631,1631,1626 

1626 DO 1630 -1 = 1, NR 
DO 1630 M= 1 , ND 
K= I NDEX ( ND , I , M ) 

L = I NDEX ( NDNR » IG*K ) 

XNZR(K)=XNZS(L) 

IF ( KTBC ) 1627,1627,1628 

1627 XNZ ( K ) =0. 

GO TO 163 

1628 XNZ(K)=XNZS(L> 

1630 CONTINUE 

GO TO 1635 
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1631 IF (NZ-1) 1635.1635* 1632 

1632 DO 1633 K = 1 » NDNR 

1633 XNZ(K>=0. 

1635 HNLGI IG)=HNLGR 
HNLGR=0.0 
HNLGLR=HNLGL 
HNLGL=0.0 

DO 1640 1 = 1, MR 
ST ( I 1=0.0 

IF (KSISC) 1640,1640,1636 

1636 ARSTI I 1=0.0 

IF (NZ-1) 1640,1640,1637 

1637 AZSTtI 1=0.0 

1640 CONTINUE 

IF (NZ-1) 1400,1400,1641 

1641 DO 1645 M=1 ,ND 
1645 DZ ( M ) = -DZ ( M ) 

VNLGR=VNLG ( IG) 

VNLG ( I G ) =0.0 
BLGR=BLG 
JUP = 0 
I Z = NZ 

GO TO 1150 

TO AVERAGE THE SAVED QUANTIES WITH THE CORRECTED VALUES SUCH 
THAT THE NET CORRECTED PORTION OF THE LEAKAGE WILL BE ZERO. 

1650 TEMP 1=0.0 
TEMP2=0.0 

IF ( KRBC ) 1652,1652,1651 

1651 TEMP1=TEMP1+HNLG( IG) 

TEMP2=TEMP2+HNLGR 

1652 IF ( KTBC 1 1654,1654,1653 

1653 TEMP1=TEMP1+VNLGR 
TEMP2=TEMP2+VNLG ( IG) 

1654 IF ( TEMP2 1 1660,1655,1660 

1655 TEMP2 = 0 . 1 E— 1 0 
1660 TEMP=-TEMP1/TEMP2 

HNLGR=TEMP*HNLGR+HNLG( IG) 

HNLGL=TEMP*HNLGL+HNLGLR 
IF (NZ-1) 1657,1657,1656 

1656 VNLGI I G ) =TEMP*VNLG( IGl+VNLGR 
BLG=TEMP*BLG+BLGR 

1657 DO 1665 IJ=1,NIJ 

XNN( I J)=TEMP*XNN( I J)+XNR( I J) 

IF ( KS I SO ) 1665,1665,1663 

1663 XJRN( I J)=TEMP*XJRN( I J)+XJRR( I J) 

IF (NZ-1) 1665,1665,1664 

1664 XJZN( IJ)=TEMP*XJZN( IJl+XJZRI IJ) 

1665 CONTINUE 

DO 1670 J=1 ,NZ 
DO 1670 M= 1 , ND 
K=I NDEX ( ND , J ,M 1 
L = I NDEX ( NDNZ , IG ,K ) 

XNOS ( L 1 =TEMP*XNOS (L)+XNOR(K) 

IF (NZ-1) 1670,1670,1668 
1668 XNOSUP ( L ) = TEMP*XNQSUP ( L ) + XN0RU 0 ( K ) 

167C CONTINUE 

IF (LZSAV) 1700,1700,1675 
1675 DO 1680 1=1, NR 
DO 1680 M= 1 , ND 
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K=INDEX<ND,I,M) 

L=INDEX<NDNR,IG,K) 

1680 XNZS(L)=TEMP*XNZS(L)+XNZR(K> 


TO COMPUTE THE NET LEAKAGES. 


1700 HNLG ( I G ) =HNLGR+HNLGL 
XNLG ( I G ) = HNLG ( IG ) 

IF ( NZ-1 ) 1720,1720,1705 
1705 VNLGI IG)=VNLG(IG)+BL6 

XNLG ( I G ) = XNLG ( IG)+VNLG< IG) 


TO APPLY ACCELERATION BY OVER-RELAXATION USING THE FLEER METHOD 
OF CHANGING THE OVER-RELAXATION FACTOR FOR THE REST OF A 
GROUPS ITERATIONS AFTER CERTAIN CONDITIONS ARE MET IF KACCEL 
IS NEGATIVE. 


1720 IF (KACCEL) 1723.1721,1722 

1721 I SC ALE = 0 
GO TO 175 

1722 OMEGAT = 0 , 

0MEGTP=0. 

IF (ITMIG-1) 1721.1721,1730 

1723 IF (ITMIG-1) 1724,1726,1725 

1724 0MEGAT=0. 

FLXER=1.0 

ISCALE=-1 

C 

1725 IF (ISCALE-2) 1726,1748.1748 

1726 FLXERP=FLXER 
FLXER = 0 .0 

DO 1727 I J= 1 »N I J 

1727 FLXER=FLXER+ABS( ( XNN ( IJl-XNA! I J ) )*V< I J) ) 
OMEGTP=OMEGAT 
OMEGAT=FLXER/FLXERP 

c 

1730 IF (EPGX-50.0*EPS) 1731.1731,1721 

1731 IF (ISCALE) 1721.1732,1733 

1732 IF <ABS<SCALE-1.0)-10.0*EPS> 1733,1733,1750 

1733 IF (KACCEL) 1735.1750,1734 

1734 FLXER=EPGX 
GO TO 1740 

C 

1735 IF ( ABS ( OMEGA T-OMEGTP ) -0.005 ) 1736,1736,1740 

1736 IF (OMEGAT-OMEGAS) 1 740 , 1 740., 1 7 37 

1737 FAC TOR = ( OMEGAT+OMEGAS ) / ( OMEGA*SOR T ( OMFGAT ) ) 
IF (FACTOR-1. C) 1738,1740,1740 

1738 SCALE1 = 2 , 0/ ( 1 . O + SOR T ( 1 . 0- ( FAC TOR* *2 ) ) ) 
SCALE2=SCALE1-1.0 

I SCALE=2 
GO TO 1745 
C 

1740 SC ALE 1 = OMEGA 
SCALE2 = 0MEC-AS 
I SC ALE= 1 
FACTOR =0, 
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1745 IF (ITMPRT-2) 1748,1746,1746 

1746 WRITE (6,200) I G» I TMI G.FLXER , OMEGAT .OMEGTP , FACTOR .SCALE 1 
C 

1748 DO 1749 IJ=1»NIJ 

1749 XNN(IJ)=SCALE1*XNN< I J ) -SCALE2*XNA ( I J ) 


STORE CERTAIN VARIABLES AND SCALE QUANT I ES FOR A GIVEN GROUP IG * 


1750 K1G=INDEX(NTYPS,IG,KCGG) 

KX=1 

DO 1775 JZ = 1 »NZ 

CALL SORAXS ( MA, V, C, CT , CGG, 

1 CGGA , TVLK, BUCLK, BUCKG 
DO 1775 1=1, NR 
I J=INDEX(NR,JZ,I ) 

XNV I J=V ( 1 J)*XNN( I J) 

XNG( IG)=XNG{ IGl+XNVIJ 
K=I ABS(MA( I J) ) 

X2G= I NDEX ( NT YNG , K » K1G ) 

IF (MA(IJ)) 1751,1752,1752 

1751 KA= K+l 

K2GA=1NDEX(NTYNG»KA,K1G) 

1752 TEMP=(XNN( IJ)-XNA( I J) )*V( IJ ) 

ESC=ESC+C(K2G)*TEMP 
TEI'*P=ABS ( TE^P ) 

ESI J=ABS(C(K2G) )*TEMP 

IF ( MA ( I J ) ) 1761,1762,1762 

1761 ESI J=ES I J+ABS ( C( K2GA ) )*TEMP 

1762 IF (ESI J-ESI JM( 16) ) 1770,1770,1765 

1765 ESI JM( I G ) =ES I J 

MXVAR I { I G ) = I J 

1770 ESM=ESM+ABS(C(K2G) )*TEMP 

IF ( MA ( I J ) ) 1771,1775,1775 

1771 ESM=ESM+ABS(C(K2GA) )*TEMP 

1775 EAM=EAM+( ( CT ( I ) /V ( I J ) ) -C ( K2G ) )*TEMP 
IF ( XNG ( I G ) ) 1785,1780,1785 

1780 ESM=0.0 
EAM=0« 0 
ESIJMI IG)=0.0 
GO TO 1790 

1785 ESM=ESM/XNG( IG) 

EAM=EAM/XNG( 16) 

ES1JM( IG)=ESI JM( I G ) /XNG ( IG ) 

ESM=ABS(ESM) 

EAM=ABS ( EAM ) 

ESI JM( IG)=ABS( ESIJMI IG) ) 

C 

1790 SCALE=SG( IG)/(SG( IGl-ESC) 

IF (SCALE) 1791,1791,1795 

1791 WRITE (6,150) SCALE, IG, ITMIG 
SCALE= 1 • 0 

C 

1795 XNG( IG)=XNG( IG)*SCALE 

XNLG ( I G ) =XNL6 ( IG)*SCALE 
HNLG ( I G ) =HNLG ( IG)«SCALE 
IF (NZ-1) 1800,1800,1796 

1796 VNLG ( I G ) = VNLG ( IG ) *SCA|_F 
C 

C SCALING OTHER QUANTITIES. 
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1800 DO 1810 J=1 »NZ 
IJ=INDEX(NR,J,NR) 

IF (ISCALE) 1801,1801,1802 

1801 TEMP=1.0 
GO TO 1803 

1802 TEMP=ORSCAL( Ij, SCALE1, SCALE2 , XN A , XNN ) 

1803 DO 1810 M=1,ND 
K=INDEX(ND,J,M) 

L = I NDE X (NDNZ»IC-,K) 

XNOSIL ) =XNOS(L )*TEMP*SCALE 
IF (NZ-1) 1810,1810,1806 

1806 XNOSUP ( L ) = XNOSlIP ( L) *TEMP*SCALE 

1810 CONTINUE 

IF (LZSAV) 1825,1825,1811 

1811 DO 1820 1=1, NR 

I J= I NDEX ( NR , NZ , I ) 

IF (ISCALE) 1812,1812,1813 

1812 TEMP=1.0 
GO TO 1814 

1813 TEMP = ORSCAL( IJ, SCALE1, SCALE2 , XN A , XNN ) 

1814 DO 1 8 2 C M = 1 » ND 
K = I NDEX ( ND , I , M ) 

L=INDEX(NDNR,IG,K) 

1 82C XNZS(L)-XNZS(L)*TEMP*SCALE 
1825 IF (KSISO) 1845,1845,1830 

1830 DO 1840 I J= 1 , N I J 

IF (ISCALE) 1831,1831,1832 

1831 TEMP= 1 . 0 
GO TO 1833 

1832 TEMP=ORSCAL ( Ij, SCALE1, SCALE2, XNA, XNN ) 

1833 XJRN ( I J ) = X JRN ( I J ) *TEMP*SCALE 

IF (NZ-1) 1840,1840,1836 

1836 XJZN(IJ)=XJZN< I J ) *TEMP*SCALE 
1840 CONTINUE 
C 

C SCALING FLUXES 

C 

1845 DO 1846 IJ=1,NIJ 

1846 XNN( IJ)=XNN( I J)*SCALE 
C 

C 

C TO CHECK THE CONVERGENCE OF THE INNER ITERATIONS.. 

C 

c 

1850 IF (ESM-EAM) 1855,1855,1860 
1855 EPGX= EAM 

GO TO 1865 
1860 EPGX=ESM 

1865 IF (KFINGI IG1-2) 1975,1866,1866 

1866 IF (ESIJMf IG1-EPG/100.0) 1870,1870,1900 

1870 IF (EPGX-EPG) 1875,1875,1900 

1875 IF ( KTBC ) 1890,1390,1880 
1880 IF (NZ-1) 1890,1890,1885 

1885 IF (ABS(VNLG( I G ) -BLG > - ( EPG/8 . 0 ) ) 1890,1890,1900 
1890 IF ( KRBC ) 1925,1925,1895 

1895 IF (ABSIHNLGI IG) -HNLGL )-(EPG/8.0) ) 1925,1925,1900 
1900 IF (EPGX-0.05*EPGMP) 1905,1905,1915 
1905 KFINGI I G ) = — 1 
GO TO 1950 

1915 IF ( ITMIG-ITMIGM) 1920,1935,1935 


130 



nnnnnnnnnnnnonnnn t* n n n n 


1920 

KFI 

NG( 

I G ) =2 


GO 

TO 

1960 

1925 

KFI 

NG ( 

I G) =0 


GO 

TO 

1950 

1935 

KFI 

NGt 

I G ) == 1 


1950 IF <EPGX-1C.0*EPG) 1955.1955,1960 

1955 IF ( I TMPRT-3 ) 1960,1956.1960 

1956 NEGPRT=1 
GO TO 1965 

I960 NEGPRT=0 
1965 JUP=0 
I Z = NZ 

GO TO 100P 


1975 RETURN 
END 

IBFTC FLUX DECK 

SUBROUTINE FLUX ( AR , AZ , DELZ, DR, DZ, MR. W, 

1 CT, ST, ARST, AZ ST , DC. XNI, XNO, XNOS, XNOSUP, XNM, XNZ. 

2 XNN , X JRN , XJZN, XNM1 8 0 , WHI TE , XLLG ) 

SUBROUTINE FLUX FOR SUBROUTINE INNER OF TDSN 


TO COMPUTE THE ANGULAR FLUX FOR ND DIRECTIONS BY RADIAL MESH 
INTERVALS AND SUM IN ORDER TO OBTAIN THE NEW AVERAGED 
FLUXES XNN. THE WEIGHTING FUNCTION W(M) SUMS TO ONE SO THE 
AVERAGE IS AUTOMATICALLY OBTAINED. THE CURRENTS ARE ALSO 
COMPUTED FOR KSIS0=1 . 


THE 

COMMON 

STATEMENTS 


COMMON 

/CALL 1 / 

KCHAIN, 

COMMON 

/CALL2 / 

KBCRED * 

1 

KREGt 

KALC, 

KGEO * 

2 

KRBC * 



3 

NR, 

NTYPS, 

NMAT , 

4 

K5I50* 

KGST, 

KCTR, 

5 



I TMI MX * 

6 

kaccel* 

KALC1, 

nfn* 

7 

KBCDUP, 

kacav. 

KGAVE, 

8 



GLAM, 

9 

RYF , 

TIMAX, 

CALC1, 

COMMON 

/CALL3/ 


1 



HZ* 

2 




3 

KONV, 

KFINSH, 

kasor. 

4 

NBF , 

ND* 

NGP1 * 

5 

NI J, 

NTYNG, 

NDNZ* 

6 

NXNZS, 

NAR* 

NC* 

7 

I TMA , 

I TMI * 

ITMIST* 

8 



NEGSOR, 

9 

TIMEX, 

TIMEZ* 



KEND * 

KEFN 


KBBC , 

KTBC , 

KLBC * 

NSN , 

NG* 

NZ* 

LBUCK, 


KCTYP * 

KCGG , 

KDREAD * 

KFLUXI* 

ITMIGM, 

NZONER, 

NZONEZ * 

N2N * 


ITMPRT* 

KNIP, 

KEDIT* 


EIGEN, 

EPS* 

XNF , 


OMEGA, 

OMEGAP 

HYt 

BF* 


KUPS, 

KCA , 

KCF , 

NZP 1 * 

NRP1 * 


NDNR , 

NDNI J * 

NDNZNGt 

NIJG* 

NBUCK* 


itmigx. 

I TD * 
LZSAV, 



SDGFG1 * 

SCALUP 
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COMMON 

/CALL4/ 

EPG, 

EPGX* 

EPGM * 

EPGMP* 

1 


omegas, omegps. 



2 

EXTRA1, 

EXTRA2 , EXTRA3, 

EXTRA4, 

EXTRA5 * 

3 

KXTRA1 » 

KXTRA2, KXTRA3, 

KXTRA4* 

KXTRA5 

COMMON 

/CINNER/ 

ITMIG 

, IG. 

IZ , 

JUP, 

1 XITGG, 

XITG6A, 

LG* 

NEGPRT * 

JZ* 

K.X 

THE DIMENSI 

ON statements 




DIMENSION 

AP ( 1 ) , 


Azm * 

DELZ ( 1 ) * 


1 

DP (1) , 


DZ ! 1 ) * 

MR ( 1 ) , 


2 

W(l) 





DIMENSION 

CT( 1) , 


ST! 1 ) * 

ARST ( 1 ) , 


1 

AZST < 1 ) , 


DC! 1) 



DIMENSION 

X N I ( 1 ) • 


X NO ( 1 ) * 

XNOS(l) , 


1 

XNOSUP ( 1 ) 

* 

XNM ! 1 ) , 

XNZt 1 ) 


DIMENSION 

XNN < 1 ) , 


X JRN ( 1 ) , 

XJZN(l) 


DIMENSION 

XNM180I 1 ) 

, 

WHITE! 1 ) 




THE FORMAT STATEMENTS 

152 FORMAT (16H ANGULAR FLUX AT.I6.9H FIXED TG*E13.5*5H FR0M,E13. 

1 10H FOR ANGLE* 13*1 8H AND MESH I NTERVAL * I A * 9H IN GR0UP*I3* 

2 1 4H AND ITERATION* 13) 

153 FORMAT <15H XNANG WAS ZER0.I4.90H TIMES OVER ALL ANGLES AND R 

1 INTERVALS WITH NON-ZERO CROSS SECTION OF Z MESH INTERVAL *13* 

2 10H AND GROUP * 13 > 

THE INTEGER FUNCTIONS 

INDEX! LENGTH, INDEXO* INDEXL) =LENGTH*t INDE xO-1 ) +INDEXL 


TO CALCULATE THE BOUNDARY ANGULAR FLUX FOR A WHITE RADIAL 
OUTER BOUNDARY. 

1000 IF (KRBC-3) 1006*1001*1006 

1001 IF (JUP) 1002*1002*1006 

1002 T EMP = 0 • 0 
WHITE! IZ)=0.0 
DO 1005 M= 1 * ND 

IF ( DR ( M ) ) 1005*1005*1003 

1003 K=INDEX<ND,IZ*M) 

L= I NDEX ! NDNZ * IG*K ) 

TEMP=TEMP+W(M) *DR !M)*XNOS(L ) 

WHITE! IZ)=WHITE( I Z ) +W ! M ) *DR ! M ) 

IF (NZ-1) 1005*1005,1004 

10 04 TEMP=TEMP+W(M)*DR ( M ) *XNO SUP ( L ) 

WHITE! IZ)=WHITE( I Z ) +W( M) *DR < M ) 

1005 CONTINUE 

WHITE! I Z ) = TEMP /WH I T E ! IZ) 

C 

c 

1006 NZN ANG=0 
C 

C TO SET UP FOR 180 DEGREE BOTTOM BOUNDARY REFLECTION. 

C 

1180=0 

IF (KBBC-4) 11010*1007.11010 

1007 IF (JUP) 1008,1008.11010 

1008 IF C IZ— 1 > 11010*1009.11010 

1009 1180=1 
Ml 8 C = 0 


5* 
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11010 DO 1550 M=1 »ND 
J1 8 0=0 

C 

C SET ANGULAR FLUX BOUNDARY CONDITIONS. 

C 

IF IDR(M)) 1025,1025.1010 

1010 M1=MR(M) 

IF (1180) 11014,11014,11011 

11011 IF (M-ND) 11012,11013.11013 

11012 IF ( ABS<W(M+1 ) 1-0.1E-09 > 11013,11013,11014 

11013 Jl 8 0= 1 

11014 GO TO (1011,1020,1020), KGED 

1011 IF ( KLEJC-l ) 1015,1020,1020 
1015 XLLG=XLLG— W (Ml ) *DR t Ml ) *XN I (Ml ) 

XNO (M) =0. 

XNI (M) =0. 

GO TO 1100 
1C2C XNO (M)=XNI (Ml ) 

XNI (M)=XNI (Ml) 

GO TO 1100 

1025 IF (KRBC-1) 1030.1035,1060 
1030 K = 1 NDEX ( ND , I Z ,M ) 

GO TO 1040 
1035 Ml =MR ( M ) 

K = I NDEX I ND , I Z *M1 ) 

1040 L = I NDEX ( NDNZ , I G , K. ) 

IF (JUP) 1045.1045,1050 
1045 XNO ( M ) =XNOS ( L ) 

XNI ( M ) =XNOS ( L ) 

GO TO HOD 

1050 XNO(M)=XNOSUP(L) 

XNI ( M ) =XNOSUP ( L ) 

GO TO 11C0 

1060 XNO ( M ) =WH I TE ( I Z ) 

XNI ( M ) =WH I TE ( IZ) 


1100 DO 1500 11=1, NR 

IF ( DR ( M ) ) 1110.1110,1105 
1105 1=11 

GO TO 1115 
1110 I =NRP 1 - 1 1 
1115 IJ=INDEX(NR,IZ,I ) 

COMPUTE THE GEOMETRY FUNCTIONS. 

1150 IP1=I+1 
MM1=M-1 

DAR = ABS ( DR ( M ) ) * ( AR ( IP1 )+AR( I ) )*DELZ( IZ > 

DBT = DAR 

IF (NZ-1) 1155,1155,1160 
1155 DAZ = 0 . 0 

GO TO 1165 

1160 DAZ=ABS(DZ(M) )*(2.0*AZ( I ) ) 

DBT=DBT+DAZ 

1165 IF ( ABS ( W( M) ) -0. 1 E-09 ) 1170,1170,1175 
1170 DC ( I )=0.0 
GO TO 118C 

1175 DC ( I )=-( W(M)*DR(M l+WIMMl ) *DR(MM1 ) )*( AR ( IP11-AR ( I ) )*DELZ< IZ ) + 
1 W ( MMl ) *DC ( I ) 
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DC ( I )=DC( I ) /W(M) 

DBT = DBT +DC t I ) 

1180 DBT = DBT+CT ( I ) 

calculate the angular average flux xnang. 

1200 IF ( DR ( M) ) 1205*1205,1210 

12C5 TEMP=DAR*XNI (M) 

GO TO 1215 
1210 TEMP=DAR*XNO(M) 

1215 IF CNZ-1 ) 1225,1225,1220 
122C K1=INDEX(ND,I ,M) 

TEMP=TEMP+DAZ*XNZ(K1) 

1225 IF ( ABS(W(M))-0.1E-08 ) 1235,1235,1230 
1230 TEMP=TEMP+DC( I )*XNM( I ) 

1235 TEMP=TEMP+ST< I ) 

IF (KSISO) 1 245 ,1245, 1240 

1240 TEMP = TEMP+DR(M)*ARST! I ) 

IF ( NZ-1 ) 1245,1245,1241 

1241 TEMP=TEMP+DZ(M)*AZST( I ) 

1245 XNANG=TEMP/DBT 

TO calculate the angular extrapolated fluxes. 

1250 TEMP=XNANG+XNANG 

IF (AB5(W(M) 1-0.1E-08 ) 1255,1255,1260 

1255 XNM( I ) =XNANG 
GO TO 1265 

1260 XNM ( I )=TEMP-XNM( I ) 

1265 IF (NZ-1) 1275,1275,1270 
127C XNZ ( K1 ) = TEMP -XNZ t K 1 ) 

1275 IF ( DR ( M ) > 1280,1280,1285 
1280 XNI (M)=TEMP-XNI (M) 

GO TO 1300 

1285 XNO ( M ) = TEMP- XNO ( M ) 

TO TEST FOR A NEGATIVE EXTRAPOLATED VALUE FOR AN ANGULAR FLUX 

1 30C IF (LG) 1305,1305,1430 
1305 IF (XNANG) 1310,1320,133 
1310 KEFN= 1310 
TEMP=XNANG 
XNANG=0 • C 

IF (NEGPRT) 1330,1330,1315 
1315 WRITE (6,152) KEFN .XNANG , TEMP ,M , I J , IG , I TM I G 
GO TO 1330 

1320 IF (ABSICT ( I ) 1-0.1E-9) 1330,1330,1325 

1325 NZNANG=NZNANG+1 

1330 IF (NZ-1) 1350,1350,1335 

1335 IF ( XNZ ( XI ) ) 1340,1350,1350 

1340 KEFN= 1 340 

TEMP=XNZ ( K 1 ) 

XNZ ( K 1 1=0.0 

IF (NEGPRT) 1350,1350,1345 
1345 WRITE (6,152) KEFN , XNZ ( < 1 ) , T EMP , M , I J , I G , I TM I G 
1350 IF (XNM(I)l 1355.1365,1365 
1355 KEFN= 1355 

TEMP=XNM( I ) 

XNM ( I )=0. 

IF (NEGPRT) 1365,1365,1360 
1360 WRITE (6,152) KEFN , XNM ( I ) , T EMP , M , I J , I G , I TM I G 



n o n no noon on nnnnnn noon 


1365 IF (DR(M)) 1370,1370,1385 
1370 IF ( XN I ( M ) ) 1375.1425.1425 
1375 KEFN= 1375 

TEMP=XNl (M) 

XN I { M J =0. 

IF (NEGPRT) 1425.1425,1380 
1380 WRITE (6,152) KEEN ,XN I ( M ) , TEMP ,M , I J , I G , I TM IG 
GO TO 1425 

1385 IF ( XNO ( M ) ) 1390.1425,1425 
1390 KEFN=139C 

TEMP = XN0 ( M ) 

XN0(M)=0. 

IF (NEGPRT) 1425.1425,1395 
1395 WRITE (6,152) KEFN ,XN0 ( M) ,TEMP,M, I J , IG , I TM IG 

CALCULATE THE NEW NEUTRON FLUX XNN (THE AVERAGE OF THE ANGULAR 
AVERAGE FLUXES). 

1425 IF ( XNANG ) 1500,1500,1430 
1430 XNN ( I J ) =XNN ( I J ) +W ( M ) *X NANG 


TO CALCULATE THE CURRENTS FOR ANISOTROPIC (P<1)1 SCATTERING. 

THE MULTIPLYING FACTOR OF (2*L-1) HAS NOT BEEN INCLUDED HERE 
SINCE IT IS IN THE GAM— I I CROSS SECTIONS. 

1450 IF (KSISO) 1500,1500,1455 
1455 XJRN ( I J 1 =XJRN ( I J ) +W ( M ) *DR ( M )* XNANG 
IF ( NZ-1 ) 1500,1500,1460 
1460 XJZNI I J ) =XJZN ( 1J)+W(M)»DZ(M)*XNANG 


1500 CONTINUE 

STORE SOME ANGULAR FLUXES FOR 180 DEGREE BOTTOM BOUNDARY 
REFLECTION. 

IF (J180) 1550,1550,1505 
1505 DO 1510 1=1, NR 
Ml 8 0=M1 80+1 

1510 XNM180(M18C)=XNM( I ) 


1550 CONTINUE 

IF (NZNANG) 1600,1600,1575 
1575 WRITE (6,153) NZNANG, IZ.IG 


1600 RETURN 
C 

END 
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o o o o o oo OOOOOOOOOOOOOOO 


SI6FTC SORAXS OECK 

SUBROUTINE SORAXS ( MA, V, C, CT, CGG, CGGA, 

1 TVLK, BUCLK, BUG KG > 

SUBROUTINE SORAXS FOR SUBROUTINE INNER OF TDSN 

TO LOOK UP THE HITHIN GROUP SCATTERING CROSS SECTION ANO THE 
TOTAL COLLISION LOSS CROSS SECTION ANO COMPUTE ANY BUCKLING 


LOSS CROSS SECTIONS 

TO ADD TO 

THE TOTAL 

COLLI SI ON 

LOSS CROSS 

SECTION. 






THE COMMON 

STATEMENTS 





COMMON 

/CAL LI/ 

KCHAIN, 

KEND, 

KEFN 


COMMON 

/CALL 2/ 

KBCRED , 




1 KREG, 

KALC, 

KGEQ, 

KBBC • 

KTBC , 

KLBC, 

2 KRBC. 



NSN, 

NG, 

NZ, 

3 NR, 

NTYPS, 

NMAT , 

LBUCK, 


KCTYP, 

4 KSISO, 

KGST, 

KCTR, 

KCGG , 

KDREAD, 

KFLUX I * 

5 


I TMI MX * 

I TMIGM, 

NZQNER, 

NZONE Z , 

6 KACC6L, 

KALC 1 , 

NFN, 

N2N, 


ITMPRT, 

7 KBCDUP, 

KACAV, 

KGAVE , 

KNIP, 

KEDIT, 


8 


GLAM, 

EIGEN, 

EPS, 

XNF, 

9 RYF , 

TIMAX, 

CALC1 * 


OMEGA, 

OMEGAP 

COMMON 

/CALL 3/ 





1 


HZ, 

HY, 

8F , 


2 




KCA, 

KCF , 

3 KONV, 

KFiNSH, 

KASOR. 

KUPS, 



4 NBF, 

ND. 

NGPl. 

NZPL , 

NRP1, 


5 NIJ. 

NT YNG • 

NDNZ , 

NDNR , 

NDN1 J , 

NDNZNG, 

6 NXNZS, 

NAR, 

NC, 

N I JG, 

N8UCK , 


7 I TM A , 

1TMI, 

I TMI ST , 

I TMI GX , 

ITD, 


8 


NEGSOR, 


LZSAV, 


9 TIMEX, 

TIMEZ, 



SDGFG1, 

SCALUP 

COMMON 

/CALL4/ 

EPG, 

EPGX, 

EPGM, 

EPGMP , 

1 


OMEGAS, 

OMEGPS, 



2 

EXTRAI, 

EXTRA2, 

EXTRA3, 

EXTRA4 , 

EXTRA5, 

3 

KXTRA1, 

KXTRA2 • 

KXTRA3, 

KXTRA4 , 

KXTRA5 

COMMON 

/CINNER/ 

ITMIG, 

IG, 

IZ, 

JUP, 

L XITGG, 

X I TGGA , 

LG. 

NEGPRT, 

JZ. 

KX 

THE DIMENSION STATEMENTS 




DIMENSION 

MAI l). 

V( 1) 

, 

cm 


DIMENSION 

CT(l), 

CGG (1) . 

CGGAI i ) 


DIMENSION 

TVLK I I ) , 

BUCLKI 1) , 

BUCKG(l) 


THE INTEGER 

FUNCTIONS 





INDEX ( LENGTH, INDEXO, I NOE XL ) =LE NGT H* ( I NDE XO- 1 ) + I NDE XL 
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ouuuu oooo uuuu 


1000 00 1175 1=1. NR 

I J= INDEX 1 NR, JZ . I I 
K= 1 ABS ( MA I I JH 
K A=K 

IF iKSISOi 1015,1015.1005 
1005 IF (MAdJil 1010,1015,1015 
101C K A=K+ 1 

TO COMPUTE THE TOTAL CROSS SECTION ANO ANY TRANSVERSE LEAKAGE 
CROSS SECTION FOR A GIVEN GROUP IG AND A GIVEN 2 MESH 
INTERVAL IZ. 

1015 K1=IND£X!NTYPS» IG.KCTR) 

CL=Q. 0 

K 2= I NOE XI NT YNG, K, K 1 ) 

CE = C( K2 } 

IF ! NBF— l ) 1050,1050,1020 
1020 K2=INDEXINTYNG,KA,KU 
CTR=C( K2 ) 

TEMP=ABS< CTR) 

CL=! ( BF/ ( T EMP*HZ+ 1* 420692161 ) ** 2 ) *CTR 
IF ( HY— 0. 1E—7 ) 1030,1030,1025 
1025 CL=CL+< IBF/ITEMP*HY*1.4208S216n**2l*CTR 
1030 IVLK< I J ) =CL*Vi IJ) 

1050 CE=CE*-CL 

IF ( LBUCK ) 1052,1052,1051 

1051 CE=CE+BUCLKI IG) 

1052 IF (NBUCK) 1054,1054,1053 

1053 K2= INDEX! NG.K, IG) 

CE=CE+BUCKG!K2) 

1054 CT l IJ= CE*V(1J) 

IF IKXi HOC, 1100, 1175 

TO STORE THE WITHIN GROUP SCATTERING CROSS SECTIONS BY VOLUME 
MESH INTERVALS. 

1100 K1=INDEX(NTYPS,IG. KCGG ) 

K2= INDEX! NT YNG*K,K1) 

CGG ( I >=C!K2)*Vl IJI 
X I T GG = X 1TGG+CGG! I 1 
IF ( KS I SO ) 1175.1175,1125 
1125 IF <KA-Ki 1130,1130.1135 
1130 CGGA! I )=0 *0 
GO TO 1175 

1135 K2=INDEX!NTYNG,KA,K1) 

CGGA ( I )=C ! K2 ) *V! I J J 
X I T GGA = X I TGGA+CGGA! I ) 


1175 CONTINUE 


RETURN 

C 

ENO 
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nooononnoo 


$ I BF TC OUMPBC CECK 

SUBROUTINE OUMPBC 

TO GIVE A BCOUMP OF THE PROBLEM. 


THE COMMON 

STATEMENTS 

COMMON 

X 

COMMON 

/CALL!/ 

COMMUN 

/CALL 2/ 

1 KREGf 

KALC, 

2 KRBC, 

3 NR, 

IvlTYPS. 

4 KS ISO, 

KGST, 

5 

6 KACCEL, 

KALC 1 , 

7 KBCOUP, 

KACAV. 

B 

9 RYF, 

T IMAX, 

CCMMUN 

/CALL 3/ 

1 

2 

3 KUNV, 

KFINSH, 

4 NBF, 

NO, 

5 NIJ, 

NTYNG, 

6 NXNZ S# 

NAR, 

7 ITMA, 

ITMI, 

8 

9 TIMEX, 

T1MEZ. 

COMMON 

1 

2 

/CALL4/ 

EXTRA1, 

3 

K X TRA 1 * 

COMMON 

/COUTER/ 

I KNI , 

KNO, 

2 KNUKUP , 

KNZR • 

3 

KNZ 

COMMON 

/CINPT1/ 

1 LKAS, 

LAG, 

2 LSCG • 

L SDG , 

3 LXNB, 

LHNLG, 

4 LAR, 

LAZ, 

5 LCT, 

LCGG , 

6 LAZSO, 

LARST, 

7 LNM , 

LTVLK, 

8 LMR , 

L to » 

COMMON 

/CINPT2/ 

1 LNA, 

L JRN , 

2 LJZR, 

L 1 60 , 

3 LNZ, 

LNGSUP, 

4 L JR , 

LJZ, 


KCHAIN, 

KtNO. 

KEEN 

KBCRED , 
KGEO, 

KBBC • 

KTBC, 


N SN t 

NG, 

NMAT * 

LBUCK, 


KCTR. 

KCGG , 

KOREAD, 

ITMIMX, 

ITMIGM, 

NZ ONE R, 

NFN , 

N2N, 


KGAVE, 

KNIP, 

KEDIT, 

GLAM, 

EIGEN, 

EPS, 

CALC1, 


OMEGA, 

HZ, 

HY, 

BF, 

KASOR, 

KUPS, 

KCA, 

NGP l , 

NZ PI , 

NRP1 , 

NDNZ , 

NDNR , 

NONI J, 

NC. 

NI JG, 

NBUCK, 

ITMIST, 

ITMIGX, 

ITD, 

NEGSOR, 


LZSAV, 

EPG, 

EPGX, 

SDGFGI, 
E PGM, 

OMEGAS, 

OMEGPS. 


EXTRA2, 

EXTRA3, 

EXTRA4, 

KXTRA2, 

KXTRA3, 

KXTRA4, 

KDR , 

KDZ, 

KMR, 


K I 80 , 

KWHITE, 

KNR, 

K JRR , 

KJZR, 

LKI , 

LKE, 

LFG , 

LFNG , 

LSG. 

LASG, 

LSING, 

LXNG , 

LJRG, 

LVNLG. 

LXNLG , 

LBUC , 

LR, 

LRM , 

LRA, 

LCGGA, 

LSISO, 

LST , 

LAZST, 

LCUPS, 

LESIJM, 

LDELZ, 

LZ, 

LDR, 

LNI , 

LNO , 

LN2N 

LMA , 

LV, 

LF, 

LJZN, 

LJRA, 

LJZ A, 

LNOR , 

LNR , 

LNORUP, 

L NZ S , 

L NO S * 

LN, 


LC, 

LNBUC, 


KLBCt 
NZ « 

KCTYP, 
KFLUX I • 
NZONEZ v 
I TMPRT » 

XNF , 
OMEGAP 


KCF « 


NDNZNG, 


SCALUP 
E PGMPt 

EXTRAS , 
KXTRA5 
KW * 
KNORt 


LKF * 
LBNLG. 

L JZ Gt 
LMXVAR, 
LRAV , 
LARSO, 
LDC » 
LDZ, 

LNN » 

L JRR* 
LNZR, 
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uu o o u u ouu 


LWH1TE. 

LBCDUP * 



LMID. 

LNMI » 

LNMR, 

LRMI « 

LD2 1 * 

LC 1 • 



LSTG, 





LNQRMf 

1 


LNMRA* 

LNMZA f 

L 1 DM* 

LIDMAP, 

' LIDGP 






COMMON 

/C1NPT 3/ 



LASTi, 

LAST2. 

LAST3. 

LAST4, 

LAST 





THE DIMENSION STATEMENTS 
DIMENSION XI 17500) 

THE FORMAT STATEMENTS 

130 FORMAT ( IFJ80HEND OF BCOUMP END OF BCOUMP END OF BCDUMP 
ID OF BCDOMR END OF BCDUMP ) 

THE INTEGER FUNCTIONS 

1NCEXI LENGTH, INDEXO, INDEXL) “LENGTH* ( I NDE XO-D + INDEXL 


980 KDUP=1 

IF IKBCDUP*1 ) 990.1030,1000 
990 KDUP=3 

KBCDUP=— KBCDUP 
GO TO 102C 

1000 IF I KBCDUP— 1 I 1100,1005,1015 
1005 IF IKONV-1) 1010.1015.1010 
1010 IF IKONV+l) 1100,1015.1100 
1015 KDUP=2 

1020 CALL BCDUMP (KREG.LAST) 

CALL BCOUMP (XII) , XI LBCDUP) ) 


1030 ITEMP1=LN— 1 
ITEMP2=LJR— 1 
ITEMP3=LJZ— 1 
DO 1040 IG- l.NG 
K 1=1 TEMP l ♦ INDEX! N I J, IG, 1) 

K2= I TEMP l* INDEX IN I J. IG.NI J ) 
CALL BCOUMP IX1K1),XIK2>) 

GO TO I 1040,1035, 1035), KDUP 

1035 IF IKSISO) 10A0.1040. 1036 

1036 K1=ITEMP2»INDEXINI J.IG.l) 

K2= I TEMP2+INDEX (N I J, IG.NI J) 
CALL BCOUMP IXIKl ), XIK2) ) 

IF INZ- 1 ) 1040,1040.1037 

1037 Kl= ITEMP3*INL)EX(NIJ. IG.U 
K2= l TEMP 3+1NDEX (N I J, IG.NI J) 
CALL BCDUMP IXIKL), XI K2)l 

1040 CONTINUE 

GO TO 11041.1045.1045), KOUP 

1041 WRITE 16.130) 

GO TO 110C 

1045 GO TO I 1041.1041,1050). KOUP 

1050 WRITE 16.130) 

LNP=LF— 1 



non 



BCuUMP ROUTINE FOR IBSYS 


ENTRY BCDUMP 


BINARY CARD 10* BCUU00U2 


uuuuo 

1 COCOO 

0 

00005 

10001 

bCDUMP SAVE 

1.2,4 

OOOOi 

0774 

oc 

2 

00000 

10000 



00002 

0 7 74 

CO 

1 

00000 

10000 



00U03 

0774 

oc 

4 

00000 

10000 



00004 

0C2C 

oc 

4 

00001 

10000 



00005 

0634 

oo 

4 

C600C 

10011 



00006 

C634 

00 

4 

00204 

10001 



00007 

0634 

00 

4 

00003 

10001 



00010 

C634 

00 

1 

00002 

10001 



000 1 1 

0634 

oc 

2 

00001 

10001 



00012 

G5C0 

oc 

4 

00003 

10000 

CLA 

3,4 

00013 

0560 

00 

4 

00004 

10000 

LDG 

4,4 

00014 

0C4C 

00 

C 

01002 

10011 

TLQ 

*+2 

00015 

G 131 

00 

0 

COOOO 

10000 

XCA 


00016 

4600 

00 

0 

00144 

10001 

STO 

WD1 

00017 

0534 

00 

1 

00144 

10001 

LXA 

WDIU 

00020 

04C2 

00 

0 

00144 

10001 

SUB 

WD1 

00021 

C 734 

00 

2 

COOOO 

10000 

PAX 

0,2 

00022 

1 OUOOl 

2 

01001 

10011 

TXI 

*+1,2,1 


BINARY CARO ID. BCDU00G3 


00023 

0634 

00 

1 

00041 

10001 


SXA 

1X1,1 

00024 

0634 

00 

2 

00C42 

10001 


SXA 

1X2,2 

00025 

0500 

60 

0 

00203 

10001 


CLA* 

OUT 

00026 

C62 1 

UO 

0 

00121 

10001 


STA 

RlTE+1 

00027 

0621 

OC 

0 

00040 

100C1 


STA 

MON 

00030 

0734 

00 

i 

00000 

10000 


PAX 

0,1 

00031 

1 0C0C1 

1 

01001 

10011 


TXI 

*+1,1,1 

00032 

0634 

CO 

1 

01001 

10011 


SXA 

*+1,1 

00033 

0441 

oc 

0 

00000 

10000 


LDl 

** 

00034 

4C56 

00 

040000 

10000 


LNT 

040000 

00035 

0C20 

oc 

0 

01002 

10011 


TRA 

*+2 

00036 

OC20 

00 

0 

01003 

10011 


TRA 

*+3 

00037 

0 C 74 

oc 

4 

07000 

10011 


TSX 

.OPEN, 4 

00040 

5 00000 

0 

00000 

10000 

MON 

MCN 

** 

00041 

0 774 

oc 

1 

00000 

10000 

IXi 

AXT 

**,1 

00042 

0 7 74 

00 

2 

00000 

10000 

1X2 

A XT 

**,2 

00043 

7 00026 

2 

00131 

10001 

TEST 

TXL 

LASTC.2,22 

00044 

2 0002 6 

2 

01001 

10011 


TIX 

*+1,2,22 

00045 

0634 

oc 

2 

00042 

10001 


SXA 

1X2,2 


BINARY CARD ID. BCDU0G04 


00046 

0774 00 

2 

00026 

10000 


AXT 

22,2 

00047 

1 00500 

2 

01001 

10011 

TEST4 

TXI 

*+1,2.320 

00050 

4634 00 

2 

00144 

10001 


SXD 

WD1.2 

00051 

2 00500 

2 

01001 

10011 


TIX 

*+1,2,320 

00052 

C634 OC 

1 

00062 

10001 


SXA 

CLA , 1 

00053 

0634 UO 

1 

00144 

10001 


SXA 

MDltl 

00054 

1 C0026 

1 

01001 

10011 

LOOP 

TXI 

*+1,1.22 

00055 

0634 00 

1 

00041 

10001 


SXA 

1X1,1 

00056 

0774 00 

4 

00027 

10000 


AXT 

23,4 

00057 

0600 00 

4 

00174 

10001 

CLEAR 

STZ 

CKSUM+23,4 


PICK UP FIRST ARGUMENT 
PICK UP SECOND ARGUMENT 


W01 HAS THE FIRST ADDRESS 
FIRST LOCATION IN INDEX 1 

THE NO- OF WORDS OUTPUTED IN INDEX 2 
TRUE WORD COUNT 


ONLY 22 WORDS OR LESS LEFT 


CLEAR THE BUFFER 
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00060 2 00001 4 41001 10011 TIX *-1,4,1 

00061 0774 00 4 00000 10000 AXT 0,4 

00062 0500 00 4 00000 10000 CLA CLA **,4 FILL THE BUFFER WITH 

00063 0601 00 4 00146 10001 STO CKSUM+1,4 NEW DATA 

00064 1 77777 4 01001 10011 TXI *+l,4,-l 

00065 2 00001 2 41003 10U11 TIX *-3,2,1 

00066 0774 00 1 00000 10000 CNUM AXT **,1 CONSECUTIVELY 

00067 0500 00 0 C0200 10001 CLA HUNBIT NUMBER 

00070 0771 00 0 00001 10000 ARS 1 THE 

BINARY CARO 10. BCDU0005 

00071 7 00143 1 01002 10011 TXL *+2,1,99 BCDUMP 

00072 1 77634 1 41002 10011 TXI *-2,1,-100 CARDS 

00073 0621 00 0 00175 10001 STA G P+ 1 FROM 

000/4 05GC 00 0 00202 10001 CLA 8ITT ZERO 

000/5 0771 OC 0 00001 10000 ARS 1 TO 

00076 7 00011 1 01002 10011 TXL *+2,1,9 999 

00077 1 7/766 1 41002 10011 TXI *-2,1, -10 

00100 OfcU QU 0 00176 10001 STO W0RD3 

00101 0 5CG 00 0 00201 10001 CLA BITU 

00102 0771 00 0 00001 10000 ARS 1 

00103 7 CUOOO 1 01002 10011 TXL *+2,1,0 

00104 1 77777 1 41002 1001 1 TXI *-2,1, -l 

00105 46C2 00 0 00176 10001 ORS W0RD3 

00106 0534 00 1 00066 10001 LXA CNUM.l 

00107 1 00001 1 01001 10011 TXI *+1,1,1 

00110 7 01747 1 01002 10011 TXL *+2,1,999 

00111 0774 OC 1 00000 10000 AXT 0,1 

00112 0634 00 1 00066 10001 SXA CNUM.l 

00113 0774 CO 1 00026 10000 AXT 22,1 COMPUTE 

BINARY CAKU ID- BCDU00C6 

00114 4 5 CC CO 0 00144 10001 CAL W01 THE 

00115 0361 00 1 00174 10001 ACL GP,1 CHECK SUM 

00116 2 00001 1 41001 10011 TIX *-1,1,1 

00117 06C2 CO 0 00145 10001 SLW CKSUM 

00120 OC 74 00 4 10000 10011 RITE TSX -WRITE, 4 WRITE THE BINARY CARD ON THE OUTPUT TAPE 

00121 0 00134 0 00000 10100 PZE **,,EUF 

00122 C CCC34 0 00144 10001 I OCD WD1,,28 

00123 0020 CC 0 00041 10001 TRA IXl 

00124 0020 00 0 01001 10011 RETURN TRA *+l 

00125 C 7 74 OC 1 00041 10001 AXT 1X1,1 

00126 0634 00 1 00123 10001 SXA RETURN-1,1 

81 00127 0634 00 0 00066 10001 SXA CNUM 

00130 RETURN BCDUMP 

00131 05CC 00 0 00124 10001 LASTC CLA RETURN 

UU132 0601 00 0 00123 10001 STC RETURN-1 

00133 0020 CO C C0047 10001 TRA TEST4 

00134 CCCCCGCCOOOO 00010 EOF CALL - FXEM . ( E0F2 ) 

00134 0074 00 4 04000 10011 

00135 1 G0001 0 01003 10011 

BINARY CARD ID. BCDU0007 

00136 0 GC204 0 00140 10100 

00137 0 COOOO 0 00143 10001 

00140 QCCCCCOCOOOO 00010 CALL EXIT 
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00 140 0C74 00 4 05000 

00141 1 C0C0C 0 01002 

00142 0 CC204 0 00141 

00143 C COCCO 0 00042 

00144 0 00000 0 00000 

00145 2CQC00000027 

00174 42GC41G04 040 

00175 1 C4C2 0400000 

00176 0 00000 C 00000 

00177 C COOOO 0 00000 

00200 0 GO CO GO C2 000 

00201 000020000000 

00202 2CCCOOOOOOOO 

00203 0 OGCOO 0 11000 

00204 OCCCCOOGOOOO 

00205 222324644447 

BINARY CARC ID. BCDU0008 

00000 

CONTROL DICTIONARY 


10011 




10011 




10100 




10000 

E0E2 

PZE 

34 

10000 

WD1 

PIE 


00001 

CK SUM 

8SS 

23 

10000 

GP 

OCT 

420041004040 

10000 


OCT 

104020400000 

10000 

WQRD3 

PZE 


10000 


PZE 


10000 

HUNBI T 

OCT 

2000 

10000 

BITU 

OCT 

2000000 0 

10000 

BITT 

OCT 

200000000000 

10011 

OUT 

PZE 

• PCH. 

10000 


♦LDIR 


10000 




Ollil 


END 



SCUICT BCDUMP 


BINARY CARO ID. BCUUOOIO 

00C2C6000O0O 
OOC 004000005 


PREFACE 

ST ART = 0 * LENGTH^ 134* TYPE =7 094* CMPLX =5 

222324644447 
0002 06 00 00 00 

BCDUMP 

DECK 

LGC-0 *LENGTH= 134 

222324644447 

OCOCOOOOOOOO 

BCDUMP 

REAL 

L0C=0 • LENGTH=0 

222324644447 

OCOCOOOOOOOO 

BCDUMP 

REAL 

L0C=0.LENGTH=0 

332667254433 

2C0000100000 

-FXEM. 

VIRTUAL 

SECT. 4, CALL 

256731636060 

2COOCC1COOOO 

EXIT 

VIRTUAL 

SECT. 5. CALL 

627062434623 

2CCCCOOCOOOO 

SYSLOC 

VIRTUAL 

SECT. 6 

334647254560 

2CCCCOOCOOOO 

.OPEN 

VIRTUAL 

SECT. 7 

336651316325 

20GOGOQCOOOO 

.WRITE 

VIRTUAL 

SECT. 8 

3247233C3360 

2CCOOCOCOOOO 

.PCH. 

VIRTUAL 

SECT. 9 


SDKEND BCDUMP 


000751 


BCDU0009 


BCDU001 l 
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SYMBOL REFERENCE DATA 


REFERENCES TO DEFINED SYMBOLS, 


CLASS 

SYMBOL 

VALUE 

REFERENCES 


BCUUMP 

00000 

130 


B1TT 

002 02 

74 


BITU 

00201 

101 


CKSUM 

00145 

57,63,117 


CL A 

00062 

52 


CLEAR 

00057 



CNUM 

00066 

106,112,1 2 7 


E0F2 

00143 

137 


EOF 

00134 

121 


CP 

00174 

73,115 


HUNBIT 

00200 

67 


IXI 

00041 

23,55,123,125 


1X2 

00042 

24,45 


..OOOI 

00003 

7 . 10 * 1 1 


..0002 

00004 



• • 0 0 C 4 

OOOC5 

0 


L AST C 

00131 

43 


LOUP 

00054 



MON 

00040 

27 


OUT 

00203 

25 


RETURN 

00124 

126.131*132 


KITE 

C0120 

26 

LCTR 

BLCTk 



UUAL 

UNUS 



LCTR 

// 




T ES T 4 

00047 

133 


TEST 

00043 



W01 

00144 

16.17.20,50,53 


h(JRD3 

00176 

100,105 


REFERENCES TO VIRTUAL SYMBOLS. 


EXIT 

5 

140 

. EX EM . 

4 

134 

.OPEN 

7 

37 

.PCH. 

9 

203 

.hKITE 

8 

120 

SYSLUC 

6 

5 


$ l EM AL .PCH. 6 » UEC K 

7 C9 4 KELMOU ASSEMBLY. 


i 1 bL OK .PCH. 


02/25/66 


SFILE -PCh. 'PCH 


• ,PP* kb AO Y .OUTPUT , 8LK=2d .MULT I KE EL . B I N . NUL I ST 


.PCHUOOO 
. PC HUGO I 
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FILE DICE I UNARY 


SFUICT .PC H • 


BINARY CARO 10. .PCHO0U3 

2CSCC20G0034 PCH F I Lfc *PCH 

GCOOOCOCOOUO 

A7233U6G6U6C 

6CfcC606C6060 

6CtC6G6C60fc0 

SThXT -PCH. 


BINARY CARD ID. .PCH0005 

OUOGO G OOCiOO 0 G4C01 

10010 .PCH. 

P2E 


PCH 

FILE 

CDGGC 

01111 

END 

CONTROL DICTIONARY 




SCL’ICT .PCH. 


BINARY CARD IC. .PCHOOC / 

CGCOOICCCOOU 


PREFACE 

U0CCG40C0C0S 
i 2A 7233C3360 

.PCH. 

DECK 

COOOOIOCOOOO 

33A72J3C3360 

.PCH. 

REAL 

OCDoUOCGUOOO 




SOKENO .PCH. 


SYMBOL REFERENCE DATA 


-PCHC002 

BIN, OUTPUT ,NuhCVN , BLK-2B 
.PCHOOOA 

.PCH. 

PCH 

,PP,READY,OUTPUT*BLK=2«*MULT I REEL .BIN.NUL iSl 

• PCH0U06 

START=0*LENGTH=i,TYPE=70VA»CMPLX=5 
LOC=0 * LENGTH= 1 
L0C=0» LENGTH=0 

00118<# • PCHUOOB 


REFERENCES TU DEF 1NE0 SYMBULS. 


CLASS 

SYMBOL 

VALUE 

REFERENCES 


.PCH. 

OuOCC 


FILE 

PCH 

1 

0 

LCTR 

BLCTR 



QUAL 

UNCS 



LCTR 

// 
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$ 1 8F IC OUTPUT CECK 

SUBROUTINE OUTPUT CMA, FG,F, XN.XJR.XJZ, 

1 V. KFING.KASORG, AG.FNG.SG.ASG.SCG.SDG, 

2 SING.XNG* XJRG, XJZG » XNB « HNLG , VNLG «XNLG « BNLG * STG, 

3 XNORH, BUCLK, MXVARI.ESIJM I 

SUBROUTINE OUTPUT IS THE OVERLAY COR CHAIN! SUBROUTINE OF TDSN 
THAT WRITES OUT THE FINAL VALUES OF THE ITERATED QUANTITIES 
AND COMPUTES AND WRITES OUT EXTRA OUTPUT BASED ON THE 
FINAL I TERATEU VALUES. 


THE COMMON STATEMENTS 


COMMON 

/CALL 1/ 

KCHAIN. 

KEND, 

KEFN 


COMMON 

/CALL2/ 

KBCRED * 




1 KREG. 

KALC. 

KGEQ • 

KBBC * 

KTBC* 

KLBC • 

2 KRBC * 



NSN* 

NG* 

NZ* 

3 NR * 

NTYPS* 

NMAT « 

LBUCK* 


KCTYP » 

4 KSISO. 

KGST. 

KCTR* 

KCGG • 

KDREAD* 

KFLUXI 

5 


ITMI MX » 

ITMIGM* 

NZONER * 

NZONEZ 

6 KACCEL. 

KALC I, 

NFN * 

N2N* 


ITMPRT 

7 KBCDOP* 

K ACA V * 

KGAVE • 

KNIP* 

KEDIT, 


8 


GLAM* 

EIGEN* 

EPS* 

XNF * 

9 RYE * 

TIMAX, 

CALC1 * 


OMEGA* 

OMEGAP 

COMMON 

1 

/CALL3/ 

HZ* 

HY. 

BF* 


2 

3 KGNV. 

KE INSH * 

KASOR* 

KOPS* 

KCA* 

KCF « 

4 NBE « 

ND* 

NGP l * 

NZ PI * 

NRP1 * 


5 N 1 J * 

NTYNG* 

NDNZ. 

NONR. 

NDNIJ* 

NDNZNG 

6 NXNZS* 

NAK, 

NC. 

NI JG, 

NBUCK* 


7 ITMA, 

ITMI • 

ITMIST* 

1TMIGX, 

ITD* 


8 


NEGSOR* 


LZSAV* 


9 TIMEX* 

TIMEZ* 



SDGFG I • 

SCALUP 

COMMON 

/CALL4/ 

EPG* 

EPGX, 

E PGM* 

EPGMP* 

1 


OMEGAS* 

OMEGPS * 



2 

EXTRA1, 

EXTRA2* 

EXTRA3 * 

EXTRA4, 

EXTRA5 

3 

KXTRA 1 * 

KXTRA2 * 

KXTRA3 * 

KXTRA4 * 

KXTRA5 

THE DIMENSION STATEMENTS 




DIMENSION 

MAI I) 





DIMENSION 

FGI 1) • 

F C 1 ) 




DIMENSION 

XN( 1). 

X JR 1 1 ) • 

XJZ(I) 


DIMENSION 

vi n 





DIMENSION 

KFINGI 1)* 

KASORGl 1) 



DIMENSION 

AG ( 1 ) » 

FNG(l) , 



1 

SGin. 

ASGli) * 

SCG ( 1 1 . 


2 

SDGI 1). 

SINGU) * 

XNG I I ) • 


3 

XJRG I L), 

XJZG 1 1 ) » 

XNBUI * 


4 

HNLG I I ) • 

VNLG ID* 

XNLGID* 


5 

BNLG I l) 
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CiUCLK ( 1J 


MXVARKl) 


DIMENSION 

1 ESIJM(I) 

DIMENSION STG(l) 

DIMENSION XNORMI 1 ) 

THE FORMAT STATEMENTS 

100 FORMAT ( 1H1 ) 

103 FORMAT I 1H I 
111 FORMAT <81141 
113 FORMAT ( 8E 1 4 «6 ) 

120 FORMAT < 126H ITMA ITMI ITMIGX ITO TIME REO EPG 

1EPGM KASOR KONV KFINSH NEUTRON BAL GLAM E 

2IGEN > 

121 FORMAT 1 14, 16,14. I 7, 3E 14. 6, 14, 1 5, 16.E1 8. 8.2F16.8 ) 

122 FORMAT ( IHK * 50HTHE GROUP CONVERGENCE, KFINSH BY GROUP < KF I NGI IG) ) I 

123 FORMAT ( 1HL • 28HTQTAL NEUTRON FLUX (XNG(IG) ) I 

124 FORMAT < IHL , 23HF I SS I ON SOURCE (FG ( IG I ) ) 

125 FORMAT (1HK.31H1N SCATTERING SOURCE CSINGIIG))) 

126 FORMAT (1HK.29H0UT SCATTERING LOSS (SDG(IG))) 

127 FORMAT ( IHK, 32HSELF SCATTERING SOURCE <SCG(IG))) 

128 FORMAT ( IHK, 35HNQN- SELF SCATTERING SOURCE (SG(IG))) 

129 FORMAT ( 1HK,22HT0TAL SOURCE ( STG( IG) ) ) 

130 FORMAT < 1HL , 26HF I SSION NEUTRONS IFNG (IG) ) ) 

131 FORMAT { 1HK,20HABSORPTIONS (AGUG))) 

132 FORMAT ( IHK, 29HHGRI ZQNTAL LEAKAGE (HNLG<IGI)I 

133 FORMAT I IHK • 27HVERTICAL LEAKAGE CVNLGMG))) 

134 FORMAT IIHK.22HNET LEAKAGE ( XNLG ( IG) ) I 

135 FORMAT ( IHL »42HN£UTRQN BALANCE I XN8< I G) I (SOURCE - LOSS I) 

136 FORMAT i IHK • 48HT0TAL FIRST DIRECTION NEUTRON CURRENT (XJRG(IG))) 
138 FORMAT ( IHK , 74HAN I SOTROPIC NON-SELF SCATTERING SOURCE WITHOUT DIRE 

1CTIDN COSINES (ASG(IG)M 

140 FORMAT { IHL ,2X , 4GHTHE FISSION RATE PER UNIT VOLUME (FUJI I) 

141 FORMAT ( 1HK.49HT0TAL SECOND DIRECTION NEUTRON CURRENT (XJZG(IG))) 

143 FORMAT < 1H 1 , 2X, 66HTHE NET FIRST DIRECTION CURRENT PER UNIT VOLUME 
1BY GROUP ( X JR ( 1 J ) I ) 

144 FORMAT ( 1H 1 * 2X • 67HTHE NET SECOND DIRECTION CURRENT PER UNIT VOLUME 
l BY GROUP <XJZ< IJ) ) ) 

145 FORMAT ( 1H1,2X,58HTHE NON- DIRECTIONAL FLUX PER UNIT VOLUME BY GROU 
IP ( XN< IJUJ 

146 FORMAT ( 1HK.2X • 3H IG=. I 3) 

147 FORMAT ( IHK • 82HTHE NUMBER OF MESH INTERVALS AT WHICH A PI SOURCE C 
1QRRECT ION WAS MADE I KASORGC IG > I ) 

148 FORMAT < 1H 1 , 51HN0RMAL IZATI ON FACTOR FOR F, XN, XJR, AND XJZ EQUALS 
1, E 16. 8) 

149 FORMAT ( IHL , 97HTHE MAXIMUM RATE OF CHANGE IN THE SELF-SCATTERING S 
10URCE OCCURS AT THE MESH INTERVAL < MXVARI < IG) ) ) 

150 FORMAT ( IHK ,25HBUCKL I NG LOSS (BUCLK(IG))) 

151 FORMAT ( IHK ,24HBUCKL I NG LOSS IBNLGUG))) 

152 FORMAT ( IHK , 68HTHE MAXIMUM RATE OF CHANGE IN THE SELF-SCATTERING S 
10URCE (ES I JM( IG)) 1 

165 FORMAT <6X,2HJ=,I3) 

170 FORMAT ( 1F$, 7F10.6) 

171 FORMAT < 1H 1 , 14HFLUX INTEGRALS) 

172 FORMAT UHS, 14HFLUX INTEGRALS) 

173 FORMAT ( IHL . 34HAVERAGE ID*BZSI OVER ENTIRE VOLUME) 

174 FORMAT < IHL ,43HAVERAGE PARALLEL ID*BSO) OVER ENTIRE VOLUME) 
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11 <3 FORMAT ( 1H$ » 43HAVERAGE PARALLEL (0*BS0) OVER ENTIRE VOLUME! 
THE INTEGER FUNCTIONS 

INDEX! LENGTH, INDE XO, I NOE XL) =LE NGTH* ( 1 NDE XO- 1 ) +1 NOE XL 


1000 WRITE (6. 100) 

WRITE 16,120) 

WRITE (6,121) 1TMA, l TMI , l TM IGX , I TD , Tl ME Z , TIMEX, 
1 KFINSH.XNB(NGPl). GLAM, EIGEN 

IF (KFINSH) 1010, 101b, 1010 
1010 WRITE (6.122) 

WRITE (6.111) (KFING(IG), IG=1,NG) 

1015 IF (KASOR) 1030.1030,1020 
1020 WRITE (6,147) 

WRITE (6.111) (KASORG(IG), IG=1.NG) 

1030 WRITE (6.149) 

WRITE (6,111) (MXVARI(IG). IG=1.NG) 

WRITE (6,152) 

WRITE (6.113) (ESIJM(IG). IG=l,NG) 


EPGM, KASOR, KONV. 


1050 SGI NGP 1 ) =0. 0 
FNGSUM=O.C 

IF (KSISO) 1052,1052.1051 

1051 ASGSUM=0.0 
XJRGSM=0.0 
X JZ GSM = 0 • C 

1052 DO 1056 10=1. NG 

IF (KSISO) 1055.1055,1053 

1053 XJRG(IG)=C.C 

IF (NZ-ll 105E. 1058, 1057 
1057 XJZG( I G )=0 . 0 
105b IJG=lN0EX(NIJ. IG.O) 

00 1054 I J= 1 ,N I J 
I JG=I J G* 1 

XJRG( IG) = XJRG( IG ) + V( I J )*X JR ( I JG ) 
IF (NZ-1) 1054,1054,1059 

1059 XJZG( IG ) =XJZG( IG ) +V( I J ) *X JZ ( I JG ) 

1054 CONTINUE 

ASGSUM = ASGSUM+A SG ( IG) 
XJRGSM=XJRGSM+XJRG( IG) 

IF (NZ-1) 1055,1055,1061 
1061 XJZGSM=XJ7GSM+XJZG( IG ) 

1055 SG(NGP1)=SG(NGP 1 ) +SG ( IG) 

1056 FNGSUM=FNGSUM+FNG ( IG) 

DO 1060 IG= 1. NGP 1 

1060 STGl I G )=SG( IG I ♦ SCGI IG I 

IF (LBUCK) 1070,1070.1068 

1068 BUCLKS=0.0 

00 1069 IG= 1. NG 

eUCLKI IG )=8UCLK ( IG )*XNGIIG) 

1069 BUCLKS=BUCLKS+BUCLK< IG) 

C 
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1U7G WRITE I 6. li?3 J 

WRITE (6.113) (XNG(IG), IG=1,NGP1) 

IF (KSISG) 1080,1080.1075 

1075 WRITE (6, 136) 

WRITE (6,113) (XJRG(IG), IG=1,NG), XJRGSN 

IF (NZ-1) 1080.1080,1076 

1076 WRITE (6,141) 

WRITE (6.113) (XJZG(IG), IG=l.NG), XJZGSM 

1080 WRITE (fc, 124) 

WRITE (6,113) IFG(IG), IG=1,NGP1) 

WRITE (6,125) 

WRITE (6.113) (SING(IG), IG=l.NGPl) 

WRITE (6,126) 

WRITE (6.113) (SDG1IG), IG=1.NGP1) 

WRITE (6,127) 

WRITE (6.113) (SCG(IG), IG=1,NGP1) 

WRITE (6.128) 

WRITE (6,113) (SG(IG), IG=1,NGP1) 

WRITE (6,129) 

WRITE (6,113) (STG(IG). IG=1,NGP1) 

IF I KS I SO ) 1090,1090,1085 
1085 WRITE 16,136) 

WRITE (6,113) (ASG(IG), 1G=1.NG), ASGSUM 

1090 WRITE (6.130) 

WRITE 16.113) IFNG(IG). IG=1.NG), FNGSUM 
WRITE (6.131) 

WRITE (6,113) (AG1IG), IG=1.NGP1) 

WRITE (6,132) 

WRITE (6.113) (HNLG(IG). 1G-1.NGP1) 

IF (NZ-1) 1092, 1092, 1091 

1091 WRITE (6.133) 

WRITE (6,113) (VNLG(IG). IG=l.NGPl> 

1092 IF ( NBF— 1 ) 1093,1093,1094 

1093 IF ( NBUCK ) 1095, 1095,1094 

1094 WRITE (6,151) 

WRITE (6,113) ( 8NLG ( IG ) , IG=l.NGPl) 

1095 IF ( LBUCK ) 1097,1097,1096 

1096 WRITE (6. 150) 

WRITE (6,113) (BUCLMIG). 1G=1 ,NG) . BUCLKS 

1097 WRITE (6,134) 

WRITE (6,113) IXNLG(IG). IG=l,NGPl) 

WRITE (6.135) 

WRITE (6,113) (XNB(IG), IG=l.NGPl) 


1100 XNMAX=0.0 

00 1105 IJG=1»N1 JG 

IF ( XNMAX— XN ( I JG ) ) 1101,1105,1105 

1101 XNMAX=XN( I JG) 
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1105 CONTINUE 

IF C XNMAX ) 1106.1107,1106 

1106 YN0RM= 1.0/XNMAX 
GO TO 1110 

1107 YN0KM= 1.0 

1110 WRITE ( 6 , 148] YN0RH 


1125 00 1130 1J=1,NIJ 
1130 XNQRMl I J )=YN0RM*F { I J ) 

WRITE (6,140) 

DO 1135 J = 1 ,NZ 
WRITE (6.165) J 
K 1= INDEX ( NR ♦ J , 1) 

K2=INDEX(NR,J.NR) 

WRITE (6,113) (XNORM(IJ), IJ=Ki,K2) 
1135 WRITE (6,103) 


1150 WRITE 16,145) 

1 JG=0 

DQ 1160 I G = 1 . NG 

00 1155 1J-1,NIJ 

1 JG= I J G+ 1 

1155 XNURM( IJ)=YNORM*XN( I JG) 

WRITE (6,146) IG 
00 1160 J=1,NZ 
WRITE (6,165) J 
K1 = IN0EX(NR, J, 1) 

K2=IN0EX(NR.J,NR) 

WRITE (6,113) (XNORM(IJ), IJ-K1.K2) 
1160 WRITE (6.103) 


IF (KSISO) 1200,1200.1165 

1165 WRITE I 6, 143) 

I J G=0 

00 1170 I G= 1 , NG 
00 1166 IJ=1,NIJ 
I J G=I J G+ 1 

1166 XNORM1 I J ) — YNORM*X JR ( IJG) 

WRITE (6,146) IG 

00 1170 J = 1 , NZ 
WRITE (6,165) J 
K1=INDEX(NR, J, 1) 

K2=INDEX(NR.J,NR) 

WRITE (6,113) IXNORM(IJ), IJ=K1,K2) 
1170 WRITE (6. 103) 


IF ( NZ— 1 ) 1200, 1200. 1171 
1171 WRITE (6.144) 


u u u u o u u 


I JG=0 

DU 1173 IG = 1 ,NG 
DO 1172 IJ=1,NIJ 
I JG-I JG+1 

1172 XNORM( I J)=YNORM*XJZ( IJG) 

WRITE 1 6*146) IG 

DO 1173 J=1,NZ 
WRITE 16*1651 J 
K1=INDEX(NR.J, 1) 

K2=INDEX(NR,J,NR) 

WRITE (6*1131 ( XNGRM ( I J ) * IJ=Ki,K2) 

1173 WRITE (6*103) 


1200 IF ( <N IP) 1300*1300,1205 
1205 WRITE (6*171) 

WRITE 16*1721 
DO 1260 N=i*NMAT 
DO 1270 IG=1.NG 
STG( IG)=0.0 
UG=INDEX(NU, IG,0) 

00 126C IJ=1,NIJ 
1JG=IJG+1 

IF i N— I A0S ( MA ( I J I ) ) 1225* 1245, 1225 
1225 IF (MAIIJ)) 1230,1260,1260 
1230 IF ( N+( MAI I J )— 1 ) ) 1260,1235,1260 
1235 TEMP=V( IJ)*XJR( IJG) 

IF 1 NZ— 1 ) 1250, 1250, 1240 
1240 TEMP=TEMP+V(IJ)*XJZ(I JG) 

GO TO 1250 

1245 TEMP=V( IJ)*XN( I JG ) 

1250 STG( IG) = STGI IGMTEMP 
1260 CONTINUE 
1270 CONTINUE 

WRITE (6,113) ( STG1 I G ) • IG=1.NG) 
WRITE 16,170) ( STG(IG), IG=1,NG) 
1280 CONTINUE 

IF (KNIP-2) 1300,1285,1300 
1285 WRITE (6.173) 

DO 1290 IG=1,NG 
1290 STG( IG)-VNLG( IG )/XNG( IG) 

WRITE (6*113) (STG(IG), IG=1,NG) 

1300 IF ( LBUCK ) 1305,1400,1305 
1305 WRITE (6,174) 

WRITE (6,175) 

DO 1310 I G= 1*NG 
1310 STG( IG)=HNLG( IG )/XNG( 1 G ) 

WRITE (6*113) (STG(IG), IG=1.NG) 
WRITE (6,170) (STGUG), 1 G=1,NG) 


1400 IF (KACAV) 1405,1401,1405 

1401 IF ( KGAVE ) 1410,1410,1405 
1405 KCHAIN=4 

RETURN 

C 

1410 IF (KEOIT) 1420,1420,1415 
1415 KCHAIN=5 
RETURN 
C 

1420 KCHAIN=l 
RETURN 
C 

END 
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SIBFIC TABLES DECK 

SUBROUTINE TABLES 1MA,C. CN2N » XN,XJR,XJZ, V, 

1 NMRA.NMZA, IOM, IDMAP,IDGP) 

C 

SUBROUTINE TABLES IS THE OVERLAY (OR CHAIN) SUBROUTINE OF TDSN 

THAT COMPUTES AND PRINTS OUT THE ACTIVITY AND AVERAGING TABLES, 


THE COMMON STATEMENTS 


COMMON 

/CAL LI/ 

KCHAIN, 

KEND, 

KEFN 


COMMON 

/CALL2/ 

KBCRED, 




1 KREG, 

KALC, 

KGEO , 

KBBC , 

KTBC, 

KLBC, 

2 KRBC , 



NSN, 

NG, 

NZ, 

3 NR, 

NTYPS, 

NMAT • 

LBUCK , 


KCTYP, 

4 KS I SO , 

KGST. 

KCTRt 

KCGG , 

KDREAD, 

KFLUXI, 

5 


I TM I MX * 

I TMIGM, 

NZONER, 

NZONEZ, 

6 KACCEL, 

KALC 1 , 

NFN , 

N2N, 


I TMPRT , 

7 KBCOUP , 

KACAV, 

KGAVE, 

KN1P, 

KEOIT, 


8 


GLAM, 

EIGEN, 

EPS, 

XNF , 

9 RYF , 

TIMAX, 

CALC1. 


OMEGA, 

OMEGAP 

COMMON 

1 

/CALL 3/ 

HZ, 

HY, 

BF, 


2 

3 KON V , 

KF IN SH , 

KASOR, 

KUPS, 

KCA, 

KCF , 

4 NBF • 

NO, 

NGP 1 * 

NZP 1 , 

NRPi. 


5 NIJ. 

NT YNG * 

NDNZ, 

NONR, 

NDNI J, 

NDNZNG, 

6 NXNZS, 

NAR, 

NC, 

NI JGt 

NBUCK , 


7 1 TMA , 

I TMI • 

I TMI ST , 

ITMIGX, 

ITD, 


8 


NEGSOR, 


LZSAV, 


9 TIMEX, 

TIME/, 



SDGFG1, 

SCALUP 

COMMON 

/CALL4/ 

EPG , 

EPGX, 

EPGM, 

EPGMP, 

1 


OMEGAS, 

OMEGPS, 



2 

EXTRA1, 

EXTRA2, 

EXTRA3, 

EXTRA4, 

EXTRA5, 

3 

KXTRA1, 

KXTRA2, 

KXTRA3, 

KXTRA4, 

KXTRA5 

COMMON 

/CTABLE / 

KTABLE * 

NACAVT, 

NTYBAR, 

KGGBAR 

COMMON 

/C SUM / 

KSUM , 

NACAV1 , 

NACAV2. 

NZM 1 , 

1 NT YG 1 * 

IG 





COMMON 

/CAVER/ 

ID, 

KF , 

KC, 

NACAV 

THE DiMENSlUN STATEMENTS 




DIMENSION 

MA( 1). 

C( 1) 




DIMENSION 

CN2N ( 1) 





DIMENS ION 

xNtn. 

XJRIU . 

xjzm 


DIMENSION 

V ( 1) 





DIMENSION 

NMRA(l), 

NMZA(I) , 

IDM(l) , 


1 

IOMAP { 1), 

I OGP < 1 ) 




DIMENSION X T Ad ( 5000 ) 

C 

C THE FORMAT STATEMENTS 

104 FORMAT ( 1HL * 2 IHPROGRAM STOP AT KEFN=,I8) 
110 FORMAT ( 7110) 
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^0 FORMAT ( 1HL » 36HTABLE S ARRAY SIZE EXCEEDED. L AST AB= , 1 8 , 31 H WITH 5 
1000 STORAGES AVAILABLE.) 

160 FORMAT I 1H1 . 16HAC TI VI TY TABLES > 

161 FORMAT ( IH1 , 17HAVERAGING TABLES ) 


C 

NZMl=NZ-l 

NTYGI=NTYPS*NGP1 

1000 IF I KACAV ) 1005.1001.1005 

1001 IF I KGAVE ) 2000.2000.1005 
1005 KUP=KCGG— (KCTR+1 ) 

KOOWN=NT YPS— KCGG 
IF (KGAVE) 1100.1100.1010 
1O10 READ 15,110) IIDGP(IG), IG=1,NG) 
KOBAR=KGAVE— l 

IF t KOOWN— KDUAR ) 1015,1020.1020 
1015 KDBAR=KDOWN 
1020 NT Y6AR=( KCTR+ 1 ) +KDB AR 
KUPBAR=0 

IF (KUP) 1075, 1G75. 1025 
1025 LBAR=NGPi— KUP 
IGB= 1 
IG= 1 

1030 IF (LBAR-IG) 1035.1035.1040 
1035 KUPBAR={KGAVE+1 )-IGB 
GO TO 1075 
104C IG=IG+1 

IF (NG-IG) 1075, 1 045 . 1045 
1045 IF ( IDGPi 1G)-IGB) 1040.1040.1050 
1050 IGB=IGB*1 
GO TO 1030 

1075 NTYBAR=NTYBARtKUPBAR 

KGGBAR=I KCTR*1 ) +KUPBAR 


COMPUTE THE ACTIVITY TABLES. 


1100 IF (KACAV) 1120.1502.1105 
1105 IF I KACAV— 2 ) 1 1 10. 150 1 . 1 1 10 
1110 WRITE (fc.loO) 

DO 1115 IJ=1,NIJ 
1115 ICMAP1 IJ )=MA( IJ ) 

NACAV=NMAT 
GO TO 1130 

1120 IF ( KACAV +2 ) 1 125. 15 0 1 . 112 5 
1125 WRITE 16.160) 

CALL I0ACAV (NR.NZ.NACAV.NZONRA.NZONZA, 
1 I DM API 1 ) ) 

1130 NACAV1=NACAV+1 
N ACAVT =NACA VI 
IF IKSISO) 1150.1150,1135 
1135 NACAV2=NACAV+2 
NACAVT =NACAV2 


NMRAI1) ,NMZA(l),IDM(l), 
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1150 LK S I = 1 

LVSUM=LKSI+NACAVT 
LFX=L VSUM+NACAVT 
LCX=LFX+NACAVT*NGPi 
LCOUT=LCX+NACAVT*NGP 1*NTYP$ 

LUISA0=LC0UT+1 

LFXBAR=LCISAO+NG 

LCXBAR=LFXBAR+l 

LCOBAR=LCXBAK+i 

LASTAB=LCCBAR 

IF (LAST Ab- 5000 ) 1200* 1200 * L 155 
1155 WRI TE (6, 120) LASTAB 
KEN0=1 
KE FN= 1 1 5 5 
GO TO 205C 

1200 K T A BL E = 1 

CALL TABLE (MA,C,CN2N. XN.XJR.XJZ, V* IDMAP.IDGP, 

1 XTAB(LKSI) ,XTA6( LVSUMI , XTA61LFX) ,XTA8(LCX> , XT AB I LCOUT ) * 

2 XT AB ( L 0 1 SAL) ) * X TAB ( LFX8 AR ) * XT AB < LCX6 AR) , XT AB < LCOBAR) ) 
IF (KEND) 1500,1500,2050 


COMPUTE THE AVERAGING TABLES. 


1500 IF (KREG) 1501.1501,2000 

1501 IF ( IABSI KACAVJ-1 ) 1503,1503,1502 

1502 WRITE (6,161) 

GO TO 1505 

1503 IF (KGAVE) 2000,2000,1505 

1505 IF (KACAV-2) 1506,1510*1510 

1 50fc IF (IABS(KACAV)-l) 1510,1510,1520 

1510 DO 1515 l J = l ,N I J 

1515 IOMAPI I J ) =MA( I J ) 

NACAV = NMA t 
GO TO 1530 

1520 CALL 1DACAV ( NR , NZ ,N ACA V , NZONRA ,NZONZ A , NMRA ( 1) , NMZ A ( 1 ) • I DM( l ) , 

1 IOMAPI 1) ) 

1530 NACAVl=NACAV+l 
NACAVT=NACAV1 
IF (KSISO) 1550,1550,1535 

1535 NACAV2=NACAV+2 
NACAVT=NACAV2 

1550 LKS 1= 1 

LVSUM=LKSI+NACAVT 
LFX=LVSUM+ 1 
LCX=L FX+NACAVT *NGP 1 
LCOUT^LCX+NACAVT*NGP 1*NTYPS 
L G I SAD=LCuUT +NACA VT*NGP l 
LF X B AR— L 0 I SAD + 1 
LCXBAR=LFXBAR+NTY6AR*KGAVE 
LCOBAR=LCXBAR+NTYBAR*KGAVE 
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1555 

C 

1600 


2000 

c 

2050 

C 


LAST AB=LCCBAR+KGA V£- 1 

IF ( LASTAb-5000) 1600,1600*1555 

WRITE (6.1201 LASTAB 

K£ND=1 

KEFN=1555 

GO TO 2050 

KT ABL E=2 

CALL TABLE (MA.C.CN2N, XN,XJR*XJZ* V, IQMAP,IDGP, 

XTABtLKSIl, XTAB ( L VSUMI * XTABILFX) *XTAB (LCX) * XT AB (LCOUT I * 

t XTAB ( L 0 1 SAO ) • XTAB (LFXBAR) , XTAB ILCXB AR> , XT AB ( LCOBAR) ) 

IF (KtND) 2000,2000,2050 


KCHAIN=5 

RETURN 

KCHA IN= 1 

WRITE (6, 1041 KEEN 
RETURN 

END 
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$ IBFTC IOACAV DECK 

SUBROUTINE IOACAV l NR . NZ * NACAV , NZONRA .NZONZA* NMRA* NMZ A. I DM, 

1 IDMAP) 

SUBROUTINE IOACAV OBTAINS THE IDENI F l CAT I ON NUMBER MAP TO USE FOR 
ACTIVITY TABLES AND AVERAGING TABLES. 


THE DIMENSION STATEMENTS 

DIMENSION NMRA ( 1), NMZA(l) , IDM<1) 

DIMENSION IUMAPU) 

THE FORMAT STATEMENTS 
110 FORMAT I 71 10) 

115 FORMAT I 1 A I 5 ) 

116 FORMAT ( A 3 1 3 ) 

120 FORMAT I 1HK * 15HMAP FOR TABLES ) 

THE INTEGER FUNCTIONS 

INDEX! LENGTH* INDE XO * I NDEXL ) =LE NGTH* (I NDEXO- 1) + INDE XL 
C 
C 
C 

1000 READ (5, 1IC) NZONRA , NZONZA 

READ (5*110) (NMRA ( I ) » 1=1, NZONRA) 

IF (NZONZA) 1005.1005.1010 
1005 NZGNZA= 1 
NMZ A ( 1 ) = 1 
GO TO 1025 

1010 READ (5.110) (NMZA(J), J=l, NZONZA) 

C 

1025 K=0 
J = 0 

NACAV=0 

00 105C JJ=1, NZONZA 

READ (5*115) (IDM(II), 11=1, NZONRA) 

K=K +NM ZA I J J ) 

1030 J=J+1 

1 = 0 

DO 10A5 11=1, NZONRA 
L = NMRA( I I ) 

DO 1035 KK= 1 * L 
i = m 

IJ=INDEX(NR*J* I ) 

1035 I DM AP ( I J ) = I DM ( I I) 

IF (1DMUD) 1036* lOAO.iOAO 

1036 IF (NACAV + ( 1DM( 1 1 )- 1 ) ) 10 37, 1 0A5 , 1 0A5 

1037 NAC AV=- I DM ( 1 1) +1 
GO TO 10A5 

10A0 IF (NACAV-IDMUI )) 10A1 * 1 0A5. I CA5 
10A1 NAC A V= I DM ( I I ) 
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1045 CONTINUE 

IF (J-K) 1030* 1G5C* 1050 

1050 CONTINUE 


1075 WRITE <6. 120) 

DO 1080 J=1*NZ 
il=INDEXINK.J*l) 

INR= INDEX 1 NR* J • NR ) 

1080 WRITE 16*116) tIDMAPUJ). IJ^II.INR) 


1100 RETURN 
C 

END 
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tIBFTC TABLE UECK 

SUBROUTINE TABLE (MA,C, CN2N, XN.XJR.XJZ. V. 

1 IOMAP, 1DGP > KSI.VSUM, FX.CX.COUT, OISAO, 

2 FXBAR.CXBAR, COBAR ) 


THE COMMON STATEMENTS 


COMMON 

/CALLI/ 

KCHAIN, 

KEND. 

KEEN 


COMMON 

/CALL2/ 

KBCRED , 




1 KREG, 

KALC, 

KGEO, 

KBBC, 

KTBC , 

KLBC, 

2 KRBC • 



NSN, 

NG, 

NZ, 

3 NR, 

NTYPS, 

NMAT • 

LBUCK, 


KCTYP, 

4 KSISO, 

KGST, 

KCTR, 

KCGG , 

KOREAD, 

KFLUXI 

5 


ITMIMX, 

ITMIGM. 

NZONER, 

NZONEZ 

6 KACCEL, 

KALC 1 , 

NFN, 

N2N. 


ITMPRT 

7 KBCDUP. 

KACA V* 

KGAVE, 

KNIP, 

KELiT, 


8 


GLAM, 

EIGEN, 

EPS. 

XNE . 

9 RYE • 

TIMAX, 

CALCI, 


OMEGA, 

OMEGAP 

COMMON 

1 

/CALL3/ 

HZ. 

>- 

X 

BE, 


2 

3 KUN V • 

KRINSH, 

KASOR. 

KUPS, 

KC A , 

KCF . 

4 NBE, 

ND* 

NGP1. 

NZPI, 

NRP1, 


5 NIJ, 

NTYNG, 

NDNZ * 

NO NR, 

NDNI J , 

NDNZ NG 

6 NXNZS, 

NAR, 

NC, 

NI JG, 

NBUCK, 


7 I TMA , 

ITMI. 

ITMIST, 

ITMIGX, 

ITD. 


8 


NEGSOR. 


LZSAV, 


9 TIMEX, 

TIMEZ. 



SDGFG1 , 

SCALUP 

COMMON 

/CALL4/ 

EPG* 

EPGX. 

EPGM. 

EPGMP, 

1 


OMEGAS. 

OMEGPS , 



2 

EXTRA I , 

EXTRA2 , 

EXTRA3, 

EXTRA4, 

EXTRAS 

3 

KXTRAI, 

KXTRA2 , 

KXTRA3, 

KXTRA4, 

KXTRA5 

CCMMON 

/CTABLE/ 

KTABLE , 

NACAVT. 

NTYBAR, 

KGGBAR 

COMMON 

/C SUM/ 

KSUM , 

NACAVI, 

NACAV2, 

NZMi, 

I NTYGIt 

IG 





COMMON 

/CAVER/ 

ID, 

KF, 

KC, 

NACAV 

THE DIMENSION STATEMENTS 




DIMENSION 

MA(I) , 

cm 




DIMENSION 

CN2N ( 1) 





DIMENSION 

XN 11), 

X JR ( 1 ) , 

XJZU) 


DIMENSION 

Vt I) 





DIMENSION 

IDMAPt 1) , 

IOGPIll 



DIMENSION 

KSII n. 

VSUMII) 



DIMENSION 

FXI1I, 

cxm 

» 

COUTI 1) 


DIMENSION 

D1 SAOI 1) 





DIMENSION 

EX EAR ( 1), 

CXBAR(l), 

COBAR ( 1 ) 



C 

C THE FORMAT STATEMENTS 

10 A FORMAT t 1HL ,2 1HPR0GRAM STOP AT KEFN=,18) 
111 FORMAT (7116) 
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113 FORMAT ( 7116.8) 

162 FORMAT ( 1FJ.17HAVER AGING TABLES ) 

163 FORMAT ( 1H1 » 2QHDI SADVANTAGE FACTORS ) 

16 A FORMAT I 1HL ) 

165 FORMAT ( IHL 1 32HZGNE IDENTIFICATION NUMBER tID»=.I3» 

166 FORMAT I 1H1.30HGR00P COLLAPSED CROSS SECTIONS) 

167 FORMAT I 1FL » 33HI .0. NUMBERS FOR COLLAPSED GROOPS ) 

168 FORMAT ( 1H$.30HGR0UP COLLAPSED CROSS SECTIONS) 

169 FORMAT C 1HT.7F 10.6) 

170 FORMAT ( 1H ) 

171 FORMAT ( 1HL.2BHT0TAL OF PIO) AND PIT) ZONES) 

172 FORMAT I IHL . 19HT0TAL OF PI1) ZONES) 

173 FORMAT I 12H GROUP TOTAL) 

174 FORMAT (1HL.128HN TO 2N REACTIONS ARE NOT ACCOUNTED FOR IN THE HIT 
1HIN GROUP SCATTERING CROSS SECTION WHICH HAS BEEN COMPUTED BY NEUT 
2R0N BALANCE ./5X.92HFR0M SCATTERING THAT CONTAINS THE EXTRA NEUTRO 
3NS AND THE TOTAL COLLISION LOSS WHICH DOES NOT) 

THE INTEGER FUNCTIONS 

INDEX! L ENGTH. INOE XO . I NOE XL ) =LENGTH* ( I NOE XO- 1 ) ♦ I NDE XL 


1000 GO TO (1150.1550). KTABLE 


COMPUTE THE ACTIVITY TABLES. 


1150 KF=0 
KC=0 

DO 1165 IO-l.NACAVT 
DO 1160 I G= l.NGP 1 
KF=KF+1 

DO 1155 N=1 .NTYPS 
KC=KC+1 

1155 CXCKC)=0.0 
1160 FX(KF)=0.C 
KSII ID)— 0 
1165 VSUM!I0)=0.0 

DO 1170 IJ=1«NIJ 

1170 VSUM1 NACA V 1 ) =VSUM ( NACA Vl) + V(IJ) 
IF CKSISO) 1200,1200.1175 
1175 VSUMINACAV2 )=VSUMTNACAV1) 

KS I ( NACAV2 ) =1 


1200 DO 1250 IG=l,NG 
1225 KSUM=1 

CALL SUM (MA.C. CN2N, XN.XJR.XJZ, V, ID MAP, KSI.VSUM, 
1 FX.CX.COUT ) 

IF IKENO) 1250.1250,2050 
1250 CONTINUE 
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1300 KF = 0 
K C= 0 

DO 1335 ID=1,NACAVT 
IF ( I D—NACAV 1 ) 1305 * 1310? 1315 
1305 WRITE 16.165) 10 
GO TO 1325 
1310 WRITE 16,171) 

GO TO 1325 
1315 WRITE (6,172) 

C 

1325 DO 1330 IG=1,NGP1 

IF (IG-NGPi) 1327, 1326, 1326 

1326 WRITE (6,173) 

1327 KF=KF+l 
K 1=KC+ 1 
K2=KC+NTYPS 

WRITE (6,113) (CXIK). K=Kl,K2), FX(KF) 

WRITE (6,170) 

1330 KOK2 
1335 CONTINUE 
C 

C COMPUTE ThE DISADVANTAGE FACTORS* 

C 

1400 WRITE (6,163) 

KF = 0 

DO 1475 10=1. NACAV 
WRITE 16,165) ID 
IF (KSI(ID)J 1405,1405,1410 
1405 KF 1=INDEX(NGP1,NACAVI,0> 

GO TO 1425 

1410 KF1=INDEX1NGP1,NACAV2,0) 

1425 00 1450 iG=l.NG 
KF 1=KF l+l 
KF=KF+1 

0 1 S A0( I G) =FX ( KF J/VSUM1 ID) 

IF (KSKiOi) 1430, 1430, 1435 
1430 OISADt IG)=DISAD( IG)/(FX(KF1)/VSUM(NACAV1 ) ) 
GO TO 1450 

14 3 5 01 SADI I G ) = C 1SAD ( I G ) / ( FX ( KF 1 ) / VSUM l NACA V2 ) ) 
1450 CONTINUE 
KF=KF+1 
C 

WRITE (6,113) (D1SA0UC), IG = 1,NG) 

1475 WRITE (6,170) 

C 

RETURN 


COMPUTE THE AVERAGING TABLES. 


1550 KF=0 
KC=0 

DO 1565 I D = 1 , NACA VT 
DO 1560 IG=1,NGP1 
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KF=KF+1 

DO 1555 N=l,NTYPS 
KC=KC+1 

1555 CX(KC)=O.C 

COUT(KF)=O.G 
1560 FX ( KF ) = 0 .0 
1565 KS I t I D ) =0 

IF (KSISO) 1600,1600.1570 
1570 KS 1 ( NACAV2 ) =1 


1600 DO 1650 IG=1,NG 
1625 KSUM=2 

CALL SUM (MA.C, CN2N * XN.XJR.XJZ. V, IDMAP, KSI.VSUM, 
1 FX* CX, COUT 1 
IF (KENO) 1650,1650.2050 
1650 CONTINUE 


1700 KC=0 

DO 1750 10= l.NACAVT 
IF (I A8S(KACAV)-i ) 1740,1740.1705 
1705 IF (ICHNACAVU 1710,1715.1720 
1710 WRITE (6,165) ID 

IF (KACAV) 1730.1740,1740 
1715 WRITE (6,171) 

GO TO 1730 
1720 WRITE (6,172) 

1730 WRITE (6,162) 

1740 CALL AVERAG ( KSI, FX.CX.COUT ) 

1750 CONTINUE 

COMPUTE THE COLLAPSED GROUP CROSS SECTIONS. 

1800 IF (KGAVE) 2000,2000,1805 

1805 WRITE (6,166) 

WRITE (6,168) 

WRITE (6,167) 

WRITE (6,111) (IDGPIIG), IG=1,NG> 

IF (N2N) 1607.1107,1806 

1806 WRITE (6,174) 

1807 KF=0 
KC=Q 

DO 1875 I D= 1 , NACA V T 
IF (I0-NACAV1) 1810, 1815, 1820 
1810 WRITE (6,165) ID 
GO TO 1825 
1815 WRITE (6.171) 

GO TO 1825 
1820 WRITE (6.172) 

C 

1825 CALL COLAPS ( KGAVE .NT YBAR , KGGBAR, IDGP, KSI, FX.CX, 

l FXBAR.CXBAR, COBAR ) 

1850 DO I860 IG=1, KGAVE 
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K1=INDEX(NTYBAR,IG* 1) 
K2=INDEX(NIYBAR« IG.NTYBAR) 

WRITE (6*113) (CXBAR(K), K=K 1 * K2 ) t 

WRITE (6,170 

1860 WRITE { 6 * 16S ) ( CXBAR ( K ) * K=K1,K2) 


1875 CONTINUE 
C 
C 
C 

2000 RETURN 


2050 WRITE ( 6* 104) KEEN 
KEEN=2050 
RETURN 
C 

END 


FXBAR (Kl> 
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SlfcFTC SUM DECK 

SUbRUUT 1NE SUM (MA,C. 
1 FX * CX • COLT ) 


CN2N • XN.XJR.XJZ, V, IUMAP, KSI, 


C 

c 


c 

c 

c 

c 


THE COMMON 

STATEMENTS 




CCMMON 

/ Cal l i / 

KCHAIN, 

KEND. 

KEFN 

COMMON 

/ CAEL2/ 

KBCRED , 



1 KKEG, 

KALC, 

KGEO, 

KbBC, 

KTBC, 

2 K.R8C * 



NSN* 

NG , 

3 NK, 

NTYPS, 

NMAT * 

LBUCK, 


4 KS1S0. 

KGST. 

KCTR , 

KCGG * 

KDREAD, 

5 


ITMI MX , 

ITMI GM, 

NZQNER, 

6 XACCEE • 

KALC 1 • 

NFN, 

N2N * 


7 K&COUP, 

KACAV, 

KGAVE . 

KNI P, 

KEDIT , 

8 


GL AM • 

EIGEN, 

EPS, 

9 kYF. 

T 1 MAX. 

CALC 1 • 


OMEGA, 

CCMMUN 

/CALL3/ 




1 


HZ. 

HY, 

3F, 

2 




KCA, 

0 KUN V * 

KF INSH, 

KASOR, 

KUPS, 


4 NQF t 

ND, 

NGP 1 * 

NZP1, 

NRP1 * 

5 N I J * 

MYNG, 

NDNZ • 

NDNR, 

NDNIJ, 

6 NXNZS* 

NAR# 

NC • 

Nl JG, 

NBUCK, 

7 1 TMA , 

ITMI, 

ITMIST, 

ITMIGX, 

ITO, 

8 


NEGSOR, 


LZSAV, 

9 TIMEX, 

TIMEZ. 



SDGFG1, 

COMMON 

/C SUM/ 

KSUM, 

NACAVI , 

NACAV2 » 

l NT YG1 * 

IG 




THE DIMENSION STATEMENTS 



DIMENSION 

MAUI. 

cm 



DIMENSION 

CN2N( n 




DIMENSION 

XN(1), 

XJKU) . 

xjzm 

DIMENSION 

V( 1) 




DIMENSION 

IDMAPt i) 




DIMENSION 

KSH 1). 

VSUM ( 1 ) 


DIMENSION 

F X { 1 ) * 

CX(I), 

COUT(l) 


KLSC * 
NZ» 

KCTYP. 
KFLUX I « 
NZONEZ * 
ITHPRT, 

XNF, 

OMEGAP 


KCF * 


NDNZNG, 


SCALUP 

NZM1, 


THE FURMAT STATEMENTS 

104 FukMAT ( 1FL .2IHPRUGRAM STOP AT KEFN=,I8) 


THE INTEGER FUNCTIONS 

INUEXtLtNGTH, INOEXO * 1 NOfcXL ) =Lt NOTH* (I ND€ X0-1I + 1 NDE XL 


C 

C 

c 

100C IJG^INDEXINIJ* 1G*Q) 
DO 1200 IJ=1.NIJ 
1JG=1JG*1 

IO=lAbSI 1DMAP ( U) ) 


VSUM. 
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I CA = 1 0 

K=I ABS(MA( IJ ) ) 

KA=K 

TEMP 1 = V ( IJ ) *XN ( IJG) 

KF= I NOEX < NGPl.ID.IG) 

GO TO ( 1010.1005). K SUM 
1005 KOUT=INDEX(NG,K, IG) 

TEMP=CN2N(K0UT )*TEMP1 
COUTIKF) =COUT(KF l+TEMP 
1010 FX(KF)=FX(KF) +TEMP1 

KF=IN0EX(NGP1.NACAV1, IG) 

GO TO ( 1020,1015) . K SUM 
1015 COUTIKF)=CQUT(KF)*TEMP 
1020 FX(KF)=FX(KF) +TEMP1 

KF=IN0EX(NGP1. I0.NGP1) 

GO TO (1030,1025). KSUM 
1025 COUr(KF)=COUT(KF) +TEMP 
1030 FX(KF) = FX(KFH-TEMP1 

KF=IN0EX(NGP1,NACAV1.NGP1) 

GO TO ( 1040.1035) . KSUM 
1035 COUT (KF)=COUT(KF)+TEMP 
1040 FX(KF)=FXIKF) +TEMP1 

IF ( 1DMAP( I J ) ) 1045.1075.1075 
1045 IDA = IDAU 

IF (MAI 1 J > ) 1055, 1050, 1050 
1050 K EN0= 1 

KEFN = 1050 
GO TO 1275 
1055 K A=KA+ 1 

TEMP2 = V( I J ) *ABS (X JR I IJG)) 

IF INZMI) 1065.1065,1060 
1060 TEMP2=TEMP2+Vl I J)*ABS( XJZ( IJG) ) 
1065 KF=INDEXINGP1 , IDA, IG) 
FX1KF)=FX(KF)+TEMP2 
KF=INDEX(NGPl,NACAV2«IG) 

FXIKF )=FX(KF) +TEMP2 

KF= I NOt X ( NGP 1 , 1 OA , NGP1 ) 

FX(KF)=FX(KF)+TEMP2 

KF=INDEX(NGP1,NACAV2,NGP1) 

FX(KF)=FX1KF)+TEMP2 

1075 00 1125 N=1 .NTYPS 

IF (KREG) 1076,1076,1080 
IC76 IF (N-KCTR) 1080.1080,1085 
1080 IGN = IG 

GO TO 1100 
1085 IGN=I G— KCGG+N 

IF ( 1GN ) 1125.1125,1090 
1090 IF (IGN-NG) 1100,1100.1125 
1100 Kl-INDEXINTYPS, IGN.N) 
K2=INDEX(NTYNG.K,K1) 
KC=1NDEX(NTYG1. 10, Kl) 

KCS= INDEX! NT YG1 .NACAV1.K1) 
TEMP=C(K2)*TEMP1 
CX ( KC )=CX ( KC ) +TEMP 
CX(KCS) = CX( KC S ) +TEMP 
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IF 

(KREG) 1 

101, 1101, 1102 

1101 

IF 

( I Gr~ I GN ) 

me. 1105,1110 

1102 

IF 

(N-KCTR) 

1105*1105,1103 

1103 

IF 

(N-KCGG) 

me. iio5*iiio 

1105 

Kt = 

INOfcX( NT YPS»NGP l» Nl 


KC= INDEX ( NTYGl.ID.KT) 
KCS-INDEXINTYG 1 *NAC AV 1 • KT) 
CX( KC)— CX( KC ) +TEMP 


CX(KCS)=CXCKCS)+TEMP 
1110 IF UD-I0A) 1115* I 12 5* 1125 

1115 K 2= INDEX { NT YNG * KA *K1 ) 
KC=1NDEX(NTYG1* IDA.Kl) 

KCS= INDEX ( NT YG1,NAC A V2*K1J 
TEMP=C(K2)*TEMP2 
CX(KC)=CX( KC I ♦TEMP 
CX(KCS)=CX<KCS)+TEMP 

IF (KREG) 1116,1116*1117 

1116 IF (IG-IGN) 1125,1120*1125 

1117 IF (N-KCTR) 1120*1120*1118 

1118 IF (N-KCGG) 1125, 1120*1125 
1120 KC=INDEX<NTYG1,IDA*KT) 

KCS- INDEX ( NTYG1 .NACA V2* KT ) 
CX(KC)=CX(KCI+TEMP 
CX ( KCS )=CX( KCS ) +TEMP 
1125 CONTINUE 
C 

1150 IF I I G — 1 1 1155*1155, 1200 
1155 IF (ID-IDA) 1165,1160,1160 
1160 GO TO < 1175.1200, KSUM 
1165 KSKIDAI^l 

GO TO < 1 17C, 1200 , KSUM 
1170 VSUMi I DA ) =VSUM< IDA V( I J) 
1175 VSUM( ID) -VSUM (ID)+V(IJ) 

C 

1200 CONTINUE 


1250 RETURN 
C 

1275 *RITE < 6* 104) KEFN 
RETURN 
C 

END 
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SIBFTC AVERAG DECK 

SUBRQUT IN fc AVERAG l KSI, FX.CX.COUT ) 


THt CUMMUN STATEMENTS 


CCMMUN 

/CALLi/ 

KCHAIN, 

KEND, 

KEFN 

COMMON 

/CALL 2/ 

KBCRED , 



1 

KREG, 

KALC, 

KGEO » 

KBBC. 

KTBC , 

z 

KRBC , 



NSN, 

NG* 

3 

NR, 

NTYPS. 

NMAT, 

LBUCK, 


4 

KSISO. 

KGST, 

KCTR » 

KCGG • 

KDREAD 

5 



ITMIMX, 

ITMIGM, 

NZONER 

6 

KACCEL, 

KALC 1 , 

NFN , 

N2N , 


7 

KBCDUP, 

KACAV, 

KGAVE, 

KNIP. 

KEDIT, 

8 



GLAM, 

EIGEN, 

EPS, 

9 

RYF • 

TIMAX, 

CALC 1 , 


OMEGA, 

COMMON 

/CALL 3/ 




1 



HZ. 

HY, 

BF, 

2 





KCA, 

3 

KON V , 

KF IN SH , 

KASOR, 

KUPS, 


4 

NBF, 

NO, 

NGPi, 

NZP1 , 

NRP1 • 

5 

NIJ. 

NTYNG, 

NDNZ, 

NDNR « 

NONI J, 

6 

NXNZS, 

NAR, 

NC, 

NI JG, 

NBUCK, 

7 

I TMA , 

ITMI, 

ITMI ST. 

I TMIGX, 

ITO, 

8 



NEGSOR, 


LZSAV, 

9 

TIMEX, 

TIMEZ, 



SDGFG1 

COMMON 

/CAVER/ 

ID. 

U. 

* 

KC, 


THE DIMENSION STATEMENTS 
DIMENSION KSI(l) 

DIMENSION FX(l), CXil), COUTH) 

THE FORMAT STATEMENTS 
113 FORMAT ( 7E 16 • 8 ) 

169 FORMAT I1H$,7F10.6) 

170 FORMAT I 1H 1 

173 FORMAT ( 1HJ , 22HCQLLAPSED TO ONE GROUP1 

174 FORMAT ( 24R 00T SCATTERING BY GROUP) 

175 FORMAT (lh$,24H OUT SCATTERING BY GROUP) 

THE INTEGER FUNCTIONS 

INOEX I LENGTH, INDEXO, I NDE XL ) =LE NGTH* (I NOE XO-1 ) ♦ I NDE XL 


1000 DO 1125 IG=l.NG 
K 1 =KC+ 1 
K2 = KC + N TYP S 
DO 1100 N— 1 , NTYP S 
KC=KC+1 

IF (N-KCTRI 1005,1005,1010 


KLBC* 

NZt 

KCTYP, 
KFLUX I 
NZONEZ 
ITMPRT 

XNF * 
OMEGAP 


KCF, 


NONZNG 


SCALUP 

NACAV 



non 


1005 IGN=IG 

GO TO 1025 
1010 IGN=i G+KCGG-N 

IF ( IGN ) HOC. 11C0. 1015 
1015 IF (IGN-NG) 1025, 1025,1100 
1025 KF=IN0EX(NGP1, ID.1GN) 

IF (N-KCTR) 1050,1030,1035 
1030 KC1=KC 
KF1=KF 

COUT(KFI=COUT(KF)/FX(KF) 

GO 10 1050 

1035 IF (KSI(IDJ) 1040,1040,1050 
1040 IF ( N— KCGC ) 1050,1075.1050 
1050 CX(KC)=CX(KC)/FX(KF) 

GO TO 1100 

1075 CX ( KC ) = CX I KC 1 )— CXI KC1— 2 I— COUT I KF I 
1100 CONTINUE 
C 

IF ( 1ABSIKACAVI-1 ) 1125,1125,1105 

1105 WRITE 16,1131 (CX(K), K=Kl,K2I, FXIKFl) 

WRITE 16.170 

IF I ID— NACAV 1 1110,1110.1115 
1110 IF IKACAVI 1115,1125,1125 
1115 WRITE (6,165) (CX1K). K=K1,K2> 

1125 CONTINUE 
C 
C 

1150 KF= INDEX! NGP 1, ID, NGP 1 ) 

K1=KC+1 
K2=KC+NTYPS 
DO 1155 N=1.KCTR 
KC=KC+1 

1155 CX(KC)=CX(KC) /FXIKFl 
KC1=KC 

ITEMP=KCTR4l 

00 1160 N= I I EMP , KCGG 
1160 KC=KC+ 1 

IF (KS1I1DI) 1170,1170.1165 
1165 CX(KC)=CX(KC1/FX(KF) 

GO TO 1175 

117C CX(KC)=CX(KCl )— CX ( KC 1—2 I 

1175 IF (IABS(KACAV)-l) 1185.1185,1180 

1180 WRITE (6,173) 

WRITE (6,113) ( CX ( K ) , K=Kl,K2). FX(KF) 

WRITt (6,170 
1185 KC=K2 

C 

WRITE (6,174) 

KF1=INDEX(NGP1« ID. 1) 

KF2=INDEX(NGP1, 1D.NG) 

WRITE (6,113) (COUT ( KF I , KF=KF l »KF2 1 
IF ( I D— NACAV ) 1150, 1190,1195 
1190 IF (KACAV) 1195,1200,1200 
1195 WRITE (6,175) 

WRITE (6.169) (COUTIKF), KF=KF 1 »KF 2) 


1200 RETURN 
C 

END 
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SIBFIC COLAPS DECK 

SUBROUTINE COLAPS 
1 FS,CS, 


KOLAPS ,NT YLAP « KGGLAP , KIG, 

FOLAPfCOLAPtOUTLAP ) 


KSI, 


SUBROUTINE CGLAPS IS 
ITHIS VERSION MUST 


TO GIVE COLLAPSED GROUP 
BE CALLED BY TABLES.) 


CROSS 


SECTIONS. 


THE COMMON STATEMENTS 


COMMON 

/CALL 1/ 

KCHAIN. 

KEND, 

KEEN 


COMMON 

/CALL2/ 

KBCRED, 




1 

KREG, 

KALC. 

KGEO, 

KBBC , 

KTBC* 

KLBC, 

2 

KRBC, 



NSN , 

NG, 

NZ, 

3 

NR, 

NTYPS, 

NMA T * 

LBUCK, 


KCTYP, 

4 

KS ISO, 

KGST, 

KCTR. 

KCGG , 

KDREAD , 

KFLUXI 

5 



ITMIMX, 

i TMIGM, 

NZONER, 

NZONEZ 

6 

KACCEL, 

KALC 1. 

NFN , 

N2N, 


ITMPRT 

7 

KBCDUP • 

KACAV, 

KGAVE , 

KNIP, 

KEOIT, 


8 



GLAM, 

EIGEN, 

EPS, 

XNF , 

9 

RYF , 

TIMAX, 

CALCi, 


OMEGA, 

OMEGAP 

CCMMON 

/CALL 3/ 





1 



HZ. 

I 

•< 

BF, 


2 





KCA. 

KCF , 

3 

KONV , 

KFINSH, 

KASOR, 

KUPS, 



4 

NBF » 

NO, 

NGP 1 » 

NZP1 , 

NRP1 , 


5 

NIJ, 

NTYNG, 

NDNZ , 

NDNR , 

NDNI J, 

NDNZNG 

6 

NXNZS, 

NAR. 

NC, 

NI JG, 

NBUCK, 


7 

ITMA, 

ITMI. 

ITMIST, 

ITMIGX, 

I TO, 


8 



NEGSOR, 


LZSAV, 


9 

TIMEX, 

TIME/. 



SDGFG1 , 

SCALUP 

COMMON 

/CAVER/ 

ID, 

KF, 

KC, 

NACAV 


THE DIMENSION 

1 STATEMENTS 


DIMENSION 

KIG! 1) 


DIMENSION 

KSII1) 


DIMENSION 

F SI 1 1 . 

C S ( 1 ) 

DIMENSION 

FOLAP! 1) , 

COLAP ( 1 


OUTLAPi 1) 


THE INTEGER FUNCTIONS 

INDEX! LENGTH, INDEX0,INDEXL)=LENGTH*1 I NDEXD- 1) + 1 NDEXL 


100C K=0 

DO 1010 I G= 1, KOLA PS 
CO 1005 N= 1 »NT YLAP 
K=K+1 

COLAP! K)=0.0 
1005 FOL AP ! K 1 *0. C 
1010 OUTLAP! I G ) =0. 0 
C 
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u u o 


1025 


1030 


1035 

1040 

1045 


1046 

1050 

1055 

1060 


C 

1100 


1105 

1110 


1115 

C 

1150 


1155 

1160 

1165 

1170 


1175 

1180 

1185 


1190 


1200 

C 


00 1 06C I G= 1 * NG 

KF=KF*1 

IGK=K I G( IG) 

INDEX I NT V LAP , 1GK, 0 ) 

00 1055 N=1 ,NTYP S 
KC=KC+l 

IF (N-KCTR) 1030,1030,1035 
K-K + 1 

FGLAPI K J-FOLAPC KI+FSIKF) 

L=KF 

GO TO 1050 

IGN = I G+KCGG—N 

IF ( IGN I 1055,1055,1040 

IF { I GN-NG) 1045,1045,1055 

IGNLAP=K I G1 IGN 1 

NL AP= IGK— IGNLAP+KGGLAP 

IF INLAP-KCTR) 1055,1055,1046 

K= I NOEX (NT YLAP , 1GK.NLAP) 

L=INDEXINGP1, ID, IGN) 

COL AP I K ) = COLAP ( K ) *C S( KC )*F S f L) 

CONTINUE 
CONTINUE 
KF=KF+ 1 
KC=KC+NT YPS 

KCTRl^KCTR-f 1 

DO 1115 IG = L.KOLAPS 

DO 1115 N=KCTR1,NTYLAP 

IGN=I G+KGGLAP— N 

IF (IGN1 1115,1115,1105 

IF (IGN-KGLAPS) 1110,1110.1115 

K-= 1 NDEXI NT YLAP , IG,N) 

L=1NDEX(NTYLAP, IGN, KCTR) 

FQLAPI K I=FOlAP( K)+FQLAP(L1 
CONTINUE 

DO 1180 1G= i, KOLA PS 

DO 1180 N= 1 .NTYLAP 

IF ( N— KCTR) 1155,1155,1160 

IGN= 1 G 

GO TO 1170 

IGN= lb— N+KGGL AP 

IF ( IGN) 1180,1180,1165 

IF (IGN-KGLAPS) 1170,1170,1180 

K= INDEX (NT YLAP, 1G.N) 

COL API KI^CDLAPIK) /FQLAPI K) 

IF (IGN-IG) 1175,1180,1175 

OUT LAP ( IGN) =OUTLAP( IGN ) +CQLAP < K ) 

CONTINUE 

IF IKSU10II 1185,1185,1200 
DO 1 1 9 C IG-l.KOLAPS 
L=I NDEXI NT YLAP, IG , KCTR ) 

K=INDEX(NTYLAP, IG, KGGLAP ) 

COL API K ) -COLAP ( L )— COLAPI L— 2)— OUTLAPI IG) 


RETURN 

END 
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<JOO<JOOOO<JOUU 


$ I BF TC EDIT DECK 

SUBROUTINE EDIT IMA.C.XN.V) 

SUBROUTINE EDIT COMPUTES ACTIVITIES, FLUX INTEGRALS, AND AVERAGE 
ACTIVITIES FOR A SPECIFIED CROSS SECTION OVER GIVEN SETS OF 
GROUPS AND REACTOR REGIONS. 


THE COMMON STATEMENTS 


COMMON 

/CALL 1 / 

KCHAIN, 

KEND. 

kefn 


COMMON 

/CALL 2/ 

K8CRED, 




1 

KREG, 

KALC, 

KGEO , 

KB9C, 

KTBC, 

KLBC , 

2 

KRBC * 



NSN , 

NG, 

NZ, 

3 

NR, 

NTYPS, 

NMAT , 

LBUCK, 


KCTYP, 

4 

KSISO, 

KGST. 

KCTR. 

KC GG , 

KOREAO, 

KFLUXI 

5 



ITMI MX , 

ITMIGM, 

NZONER, 

NZONEZ, 

6 

KACCEL , 

KALC1. 

NFN , 

N2N , 


ITMPRT 

7 

K6CDUP. 

K AC A V* 

KGAVE. 

KNIP, 

KEDIT, 


8 



GLAM. 

EIGEN, 

EPS, 

XNF , 

9 

RYF, 

T IMAX, 

CALC 1 * 


OMEGA, 

OMEGAP 

COMMON 

/CAL L 3/ 





l 



HZ. 

HY, 

BF, 


2 





KC A, 

KCF , 

3 

KQN V , 

KF IN SH , 

KASOR, 

KUPS, 



4 

N8E , 

NO. 

NGP I , 

NZP1, 

NRP1, 


5 

NIJ, 

NTYNG, 

NDNZ. 

NONR , 

NONI J, 

NONZNG 

6 

NXNZS. 

NAR, 

NC, 

NI JG, 

NBUCK • 


7 

ITMA, 

ITMI, 

ITMIST, 

I TMIGX, 

I TO , 


8 



NEGSOR. 


LZSAV, 


9 

TIMEX. 

TIME/, 



SOGFGl, 

SCALUP 

COMMON 

/ CAL L4/ 

EPG, 

EPGX , 

E PGM, 

EPGMP , 

1 



OMEGAS, 

OMEGPS, 



2 


EXTRA!. 

EXTRA2, 

EXTRA3, 

EXTRA4, 

EXTRAS 

3 


KXTRA1 , 

KXTRA2, 

KXTRA3 , 

KXTRA4, 

KXTRA5 


C 

C THE DIMENSION STATEMENTS 

DIMENSION MA(1), CUT, XNU) , 

1 VI i) 

DIMENSION AC TINT! 201), FINTI201), PAVEI201) 

C 

C THE FORMAT STATEMENTS 

100 FORMAT I lhl ) 

101 FORMAT ( 1HL ) 

110 FORMAT (7110) 

112 FORMAT (7F10.6) 

113 FORMAT (7E16.8) 

200 FORMAT (1HL.9HED1T SET ,12) 

201 FORMAT I 1HL , l OH I N TEGRAL S .I3.18H HAVE LIMITS FROM ,12. 4H TO ,12, 

1 I2H ON GRUUPS, . I2.4H TO ,I2,31H ON RADIAL MESH INTERVALS, ANO 

2 .12. AH TO .I2.2AH ON AXIAL MESH INTERVALS) 

202 FORMAT I 1 HL , 12H S I GMA EOUAL S , E 1 6. 8 , 1 4H FOR OPTION 1) 
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ouo u u u u u o ooo 


203 FORMAT ( 1HL , 32 hAC T I V I TY INTEGRALS FOR EDIT SET ,131 

204 FORMAT (lhL,2BHFLUX INTEGRALS FOR EOIT SET ,131 

205 FORMAT I 1HL , 32HAVER AGE ACTIVITIES FOR EOIT SET ,13) 


C 

C THE INTEGER FUNCTIONS 

INOEX( L ENGTH, INDE XO, I NDEXLI ^LENGTH* ( 1 NDEXO-1 )«-! NOE XL 


1000 WRITE 16,100) 

READ 15.110) NISET 
DO 1175 ISET=1, NISET 
WRITE (6,200) I SET 
READ (5,110 INT 
INTP1= INT+l 
ACT I NT( INTP 1 ) =0.0 
F I NT< I NTP 1 ) =0*0 

DO 1150 IN= 1 , INI 

READ (5.110 1G1, 1G2,1R1,1R2,IZ1,1Z2 

WRITE (6,201) IN, IG1,IG2,IR1,IR2,IZ1,IZ2 
ACT INK IN ) =0*0 
FINK IN ) = 0.0 

1020 DO 1125 I G~ 1G 1 . 1G2 

GO TO (1025,1050,1055,1060), KEOIT 
1025 READ ( 5,112) SIGMA 
WRITE (6,202) SIGMA 
GG TO 1075 

1050 K1=INDEX(NTYPS,1G,KCA) 

GO TO 1075 

1055 K 1= I NDEXI NTYPS, IG, KCF ) 

GO TO 1075 

1060 K 1- INDEX( NT YPS, IG* KCTR) 

1075 DO 1125 J-1Z1.IZ2 
DC 1125 I = IR 1, IR2 
I J= INDEX ( NR , J * I ) 

IJG= INDEX (NIJ.IG, IJ) 

GO TO (iliC, HOC, 1100. 11001, KEDIT 
1100 K= 1 ABS ( MA ( IJ) ) 

K2= INDEX! NT YNG*K»K1) 

SIGMA=C(K2) 

U 10 ACT INK INTACT INK I N ) +SIGMA*XN (I JG) *V ( I J) 
1125 FINK IN ) = E INT ( I N KXN ( I JG ) ♦VU J ) 


ACT INK INTP 1 )=ACT INK INTP1 KACTINT (IN) 
FINK INTP 1 )=F INT ( INTP 1KF INK IN) 

1150 PAVfcl IN ) =ACT INT(1N)/F1NT(IN) 

PAVE( INTP 1)=ACT INK I NTP 1 ) /F INT ( I NTP1 ) 


1175 


WRITE (6,203) 
WRITE (6,113) 
WRITE (6,204) 
WRITE (6,113) 
WRITE (6,205) 
WRITE (6,113) 
WRITE (6,101) 
CONTINUE 


I SET 

( ACT1NT (IN) 
(SET 

I FINK IN), 

I SET 

( PA VE ( IN), 


, IN=1 , INTP1 I 
1N=1 , INTPl ) 
IN=1 , INTP 1 ) 


C 


RETURN 

END 
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LISTING OF SAMPLE PROBLEM OUTPUT 

OvtRLAY UR1G1N CARDS AND ASSIGNED LINK NUMdtRS 


tORIGIN 

T u SN C C 

1 s 

LINK 

l . 

PARENT 

LINK 

is 

0 

(ORIGIN 

T 0 SN 00 

I s 

LINK 

2, 

PARENT 

LINK 

IS 

0 

(ORIGIN 

TUSN21 

I s 

LINK 

3, 

PARENT 

LINK 

IS 

2 

$0RI GIN 

T 0SN22 

I s 

LINK 

<t. 

PARENT 

LINK 

IS 

3 

$0RI GIN 

TOStsiOO 

l s 

LINK 

3, 

PARENT 

LINK 

IS 

0 

(URlGlN 

7 DSN 00 

I s 

LINK 

6, 

PARENT 

LINK 

IS 

0 

JUKI GIN 

7 0 SN b 1 

I s 

LINK 

U 

PARENT 

LINK 

IS 

6 

S0RIG1N 

T D SivJo i 

I s 

LINK 

a. 

PARENT 

LINK 

Is 

6 

(ORIGIN 

7 DSNS? 

1 s 

LINK 

9, 

PARENT 

LINK 

IS 

a 

(ORIGIN 

1 USN62 

I s 

LINK 

10, 

PARENT 

LINK 

IS 

a 

(ORIGIN 

7 L)SN6? 

1 s 

LINK 

11. 

PARtNT 

LI NK 

IS 

a 

(ORIGIN 

TOS.mGO 

1 s 

link 

1? • 

PAREIM7 

LINK 

IS 

u 
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M E HI 0 R Y 


MAP 


SYSTEM 

FILE BLOCK ORIGIN 

NUMBER OF F ILES - 4 

1. REAU5 

2. PCH 

3 . UN I T Ob 
4. UN1T06 

FILE LIST ORIGIN 

PRE-EXECuT IUN IN 1 1 i AL 12 AT ION 

CALL ON OBJECT PROGRAM 

OBJECT PROGRAM 


1. 

DECK 

• TGSN * 

* 


OVERLAY COMMUNICATION 

2. 

DECK 

•INPuT • 

* 

3. 

DECK 

•KEADSV* 

♦ 

4. 

DECK 

•XSTUSN* 

* 

5. 

DECK 

• SETUP ' 

* 

6. 

DECK 

• BUREAU • 

* 

7. 

DECK 

• .KEAU5 * 

* 

b . 

DECK 

•OUTER • 

* 

9. 

DECK 

•ORSCAL • 

* 

10. 

DECK 

•FI SION ' 

* 

11. 

DECK 

•FIXED • 


12. 

DECK 

•INNER • 

* 

13. 

DECK 

•FLUX ’ 

* 

14. 

DECK 

•SURAXS 1 


15. 

DECK 

• UUMPBC * 

* 

16. 

DECK 

•BCOUMP • 

* 

17. 

DECK 

• .PCH. • 

* 

IB. 

DECK 

•OUTPUT • 

* 

19. 

DECK 

•TABLES' 

* 

20. 

DECK 

• IUACAV' 

* 

21. 

DELK 

•TABLE • 

* 

22. 

DECK 

* SUM • 

* 

23. 

DECK 

• Av LRA>j ' 

* 

24. 

DECK 

•CULAPS • 

* 

25. 

DECK 

•EDIT • 

* 

26. 

SUBR 

• .16SYS* 


27. 

SUBR 

• .LRCCN • 


2B. 

SUBR 

• . IUEX • 


29. 

SUBR 

• .JBCON* 


30. 

SUBR 

• .LXCUN • 


31. 

SUBR 

• . 1G0EF * 


32. 

SUBR 

• . IOCSF ■ 



UOOOO THRU 
02720 

03000 

03010 

03041 

03046 THRU 

C3046 LINK NC. 0 

C506C 

0 

15037 

1 

20601 

1 

2534 7 

1 

26445 

1 

30617 

1 

30731 

1 

15037 

2 

21314 

2 

21375 

3 

22413 

3 

23627 

4 

31327 

4 

33547 

4 

15037 

5 

15464 

5 

15672 

5 

15673 

5 

15037 

6 

30022 

7 

30022 

8 

31661 

9 

31661 

10 

31661 

11 

15037 

12 

coooo 

0 

coooo 

0 

0G7C2 

0 

02652 

0 

05161 

0 

05515 

0 

C5734 

0 


02717 


34262 
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33. 

SUbR 

• . LU VK Y 4 

* 10227 


0 


34. 

SUbR 

«.LXSl * 

1 0606 


0 


33. 

SU8K 

• .FPTkP * 

10745 


0 


36 . 

SUbR 

•ROUT • 

11413 


0 


37. 

SUbR 

•FGIVV ■ 

11461 


0 


38. 

SUbR 

‘rlQS ' 

13203 


u 


39. 

SUbR 

'HUH 4 

13366 


0 


40. 

SUbR 

4 F SEE • 

14331 


0 


41. 

SUBR 

*i-RRO • 

14416 


0 


42. 

SUbft 

•FRUU 4 

144^5 


0 


43. 

SUBR 

* UN 05 1 

14477 


0 


44. 

SUBR 

* UN 06 4 

14500 


0 


43. 

SUbR 

•FSCN • 

14503 


0 


46. 

SUBR 

•ESQk • 

14o5 7 


0 


47. 

SUbR 

• • I UE . 4 

14723 


0 


48. 

SUBR 

4 . 1 UE 56 4 

14744 


0 


49. 

SUBR 

4 *R *.DOE • 

14 760 


0 


30. 

SUbR 

* • SNT L • 4 

130UC 


0 


31. 

SUBR 

4 . SGk TN 4 

* 15004 


0 


52. 

SUbR 

4 T i M E 1 4 

* 15007 


0 


33. 

SUBR 

*// 

3 5644 


0 


(* - 

INSERT IC.NS OR DELETIONS MADE IN THIS DECK) 




INPUT - 

OUTPUT 

BUFFERS 


3A263 

THRU 

35626 

UNUSED 1 

:oke 



35627 

THRU 

356A3 


BEGIN EXECUTION 



CARLSUN TEST PROBLEM SLAB C*i 

3 bRUUPS S(B) 32 INTERVALS 


* 
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u 

co 
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Z 

<NJ 

3 



O 
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o a. 
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o 


0 o o o 

1 
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